diff --git a/Cabal.cabal b/Cabal.cabal --- a/Cabal.cabal +++ b/Cabal.cabal @@ -1,5 +1,5 @@ name: Cabal -version: 1.20.0.4 +version: 1.22.0.0 copyright: 2003-2006, Isaac Jones 2005-2011, Duncan Coutts license: BSD3 @@ -19,12 +19,15 @@ organizing, and cataloging Haskell libraries and tools. category: Distribution cabal-version: >=1.10 -build-type: Simple +build-type: Custom -- Even though we do use the default Setup.lhs it's vital to bootstrapping -- that we build Setup.lhs using our own local Cabal source code. extra-source-files: - README tests/README changelog + README.md tests/README.md changelog + doc/developing-packages.markdown doc/index.markdown + doc/installing-packages.markdown + doc/misc.markdown -- Generated with 'misc/gen-extra-source-files.sh' & 'M-x sort-lines': tests/PackageTests/BenchmarkExeV10/Foo.hs @@ -124,17 +127,22 @@ library build-depends: - base >= 4 && < 5, - deepseq >= 1.3 && < 1.4, - filepath >= 1 && < 1.4, - directory >= 1 && < 1.3, - process >= 1.0.1.1 && < 1.3, - time >= 1.1 && < 1.5, - containers >= 0.1 && < 0.6, - array >= 0.1 && < 0.6, - pretty >= 1 && < 1.2, + base >= 4.2 && < 5, + binary >= 0.7 && < 0.8, + deepseq >= 1.3 && < 1.5, + filepath >= 1 && < 1.4, + directory >= 1 && < 1.3, + process >= 1.1.0.1 && < 1.3, + time >= 1.1 && < 1.6, + containers >= 0.1 && < 0.6, + array >= 0.1 && < 0.6, + pretty >= 1 && < 1.2, bytestring >= 0.9 + -- Needed for GHC.Generics before GHC 7.6 + if impl(ghc < 7.6) + build-depends: ghc-prim >= 0.2 && < 0.3 + if !os(windows) build-depends: unix >= 2.0 && < 2.8 @@ -172,16 +180,15 @@ Distribution.Simple.Compiler Distribution.Simple.Configure Distribution.Simple.GHC + Distribution.Simple.GHCJS Distribution.Simple.Haddock Distribution.Simple.HaskellSuite Distribution.Simple.Hpc - Distribution.Simple.Hugs Distribution.Simple.Install Distribution.Simple.InstallDirs Distribution.Simple.JHC Distribution.Simple.LHC Distribution.Simple.LocalBuildInfo - Distribution.Simple.NHC Distribution.Simple.PackageIndex Distribution.Simple.PreProcess Distribution.Simple.PreProcess.Unlit @@ -211,6 +218,7 @@ Distribution.System Distribution.TestSuite Distribution.Text + Distribution.Utils.NubList Distribution.Verbosity Distribution.Version Language.Haskell.Extension @@ -219,8 +227,10 @@ Distribution.Compat.CopyFile Distribution.Compat.TempFile Distribution.GetOpt + Distribution.Simple.GHC.Internal Distribution.Simple.GHC.IPI641 Distribution.Simple.GHC.IPI642 + Distribution.Simple.GHC.ImplInfo Paths_Cabal default-language: Haskell98 @@ -230,7 +240,10 @@ test-suite unit-tests type: exitcode-stdio-1.0 hs-source-dirs: tests - other-modules: UnitTests.Distribution.Compat.ReadP + other-modules: + UnitTests.Distribution.Compat.CreatePipe + UnitTests.Distribution.Compat.ReadP + UnitTests.Distribution.Utils.NubList main-is: UnitTests.hs build-depends: base, @@ -238,7 +251,7 @@ test-framework-hunit, test-framework-quickcheck2, HUnit, - QuickCheck < 2.7, + QuickCheck < 2.8, Cabal ghc-options: -Wall default-language: Haskell98 @@ -279,11 +292,13 @@ hs-source-dirs: tests build-depends: base, + binary >= 0.7 && < 0.8, + containers, test-framework, test-framework-quickcheck2 >= 0.2.12, test-framework-hunit, HUnit, - QuickCheck >= 2.1.0.1 && < 2.7, + QuickCheck >= 2.1.0.1 && < 2.8, Cabal, process, directory, diff --git a/Distribution/Compat/CreatePipe.hs b/Distribution/Compat/CreatePipe.hs --- a/Distribution/Compat/CreatePipe.hs +++ b/Distribution/Compat/CreatePipe.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP, ForeignFunctionInterface #-} module Distribution.Compat.CreatePipe (createPipe) where -import System.IO (Handle) +import System.IO (Handle, hSetEncoding, localeEncoding) -- The mingw32_HOST_OS CPP macro is GHC-specific #if mingw32_HOST_OS @@ -15,6 +15,7 @@ import GHC.IO.Device (IODeviceType(Stream)) import GHC.IO.Handle.FD (mkHandleFromFD) import System.IO (IOMode(ReadMode, WriteMode)) +#elif ghcjs_HOST_OS #else import System.Posix.IO (fdToHandle) import qualified System.Posix.IO as Posix @@ -31,6 +32,8 @@ return (readfd, writefd) (do readh <- fdToHandle readfd ReadMode writeh <- fdToHandle writefd WriteMode + hSetEncoding readh localeEncoding + hSetEncoding writeh localeEncoding return (readh, writeh)) `onException` (close readfd >> close writefd) where fdToHandle :: CInt -> IOMode -> IO Handle @@ -46,10 +49,14 @@ foreign import ccall "io.h _close" c__close :: CInt -> IO CInt +#elif ghcjs_HOST_OS +createPipe = error "createPipe" #else createPipe = do (readfd, writefd) <- Posix.createPipe readh <- fdToHandle readfd writeh <- fdToHandle writefd + hSetEncoding readh localeEncoding + hSetEncoding writeh localeEncoding return (readh, writeh) #endif diff --git a/Distribution/Compat/ReadP.hs b/Distribution/Compat/ReadP.hs --- a/Distribution/Compat/ReadP.hs +++ b/Distribution/Compat/ReadP.hs @@ -14,7 +14,7 @@ -- it makes no difference which branch is \"shorter\". -- -- See also Koen's paper /Parallel Parsing Processes/ --- (). +-- (). -- -- This version of ReadP has been locally hacked to make it H98, by -- Martin Sjögren diff --git a/Distribution/Compat/TempFile.hs b/Distribution/Compat/TempFile.hs --- a/Distribution/Compat/TempFile.hs +++ b/Distribution/Compat/TempFile.hs @@ -25,7 +25,7 @@ import System.Posix.Internals (c_getpid) -#ifdef mingw32_HOST_OS +#if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS) import System.Directory ( createDirectory ) #else import qualified System.Posix @@ -38,6 +38,7 @@ -- This is here for Haskell implementations that do not come with -- System.IO.openTempFile. This includes nhc-1.20, hugs-2006.9. -- TODO: Not sure about JHC +-- TODO: This file should probably be removed. -- This is a copy/paste of the openBinaryTempFile definition, but -- if uses 666 rather than 600 for the permissions. The base library @@ -120,7 +121,7 @@ | otherwise -> ioError e mkPrivateDir :: String -> IO () -#ifdef mingw32_HOST_OS +#if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS) mkPrivateDir s = createDirectory s #else mkPrivateDir s = System.Posix.createDirectory s 0o700 diff --git a/Distribution/Compiler.hs b/Distribution/Compiler.hs --- a/Distribution/Compiler.hs +++ b/Distribution/Compiler.hs @@ -1,4 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.Compiler @@ -33,13 +35,22 @@ -- * Compiler id CompilerId(..), + + -- * Compiler info + CompilerInfo(..), + unknownCompilerInfo, + AbiTag(..), abiTagString ) where +import Data.Binary (Binary) import Data.Data (Data) import Data.Typeable (Typeable) import Data.Maybe (fromMaybe) import Distribution.Version (Version(..)) +import GHC.Generics (Generic) +import Language.Haskell.Extension (Language, Extension) + import qualified System.Info (compilerName, compilerVersion) import Distribution.Text (Text(..), display) import qualified Distribution.Compat.ReadP as Parse @@ -49,13 +60,15 @@ import qualified Data.Char as Char (toLower, isDigit, isAlphaNum) import Control.Monad (when) -data CompilerFlavor = GHC | NHC | YHC | Hugs | HBC | Helium | JHC | LHC | UHC +data CompilerFlavor = GHC | GHCJS | NHC | YHC | Hugs | HBC | Helium | JHC | LHC | UHC | HaskellSuite String -- string is the id of the actual compiler | OtherCompiler String - deriving (Show, Read, Eq, Ord, Typeable, Data) + deriving (Generic, Show, Read, Eq, Ord, Typeable, Data) +instance Binary CompilerFlavor + knownCompilerFlavors :: [CompilerFlavor] -knownCompilerFlavors = [GHC, NHC, YHC, Hugs, HBC, Helium, JHC, LHC, UHC] +knownCompilerFlavors = [GHC, GHCJS, NHC, YHC, Hugs, HBC, Helium, JHC, LHC, UHC] instance Text CompilerFlavor where disp (OtherCompiler name) = Disp.text name @@ -125,8 +138,10 @@ -- ------------------------------------------------------------ data CompilerId = CompilerId CompilerFlavor Version - deriving (Eq, Ord, Read, Show) + deriving (Eq, Generic, Ord, Read, Show) +instance Binary CompilerId + instance Text CompilerId where disp (CompilerId f (Version [] _)) = disp f disp (CompilerId f v) = disp f <> Disp.char '-' <> disp v @@ -138,3 +153,52 @@ lowercase :: String -> String lowercase = map Char.toLower + +-- ------------------------------------------------------------ +-- * Compiler Info +-- ------------------------------------------------------------ + +-- | Compiler information used for resolving configurations. Some fields can be +-- set to Nothing to indicate that the information is unknown. + +data CompilerInfo = CompilerInfo { + compilerInfoId :: CompilerId, + -- ^ Compiler flavour and version. + compilerInfoAbiTag :: AbiTag, + -- ^ Tag for distinguishing incompatible ABI's on the same architecture/os. + compilerInfoCompat :: Maybe [CompilerId], + -- ^ Other implementations that this compiler claims to be compatible with, if known. + compilerInfoLanguages :: Maybe [Language], + -- ^ Supported language standards, if known. + compilerInfoExtensions :: Maybe [Extension] + -- ^ Supported extensions, if known. + } + deriving (Generic, Show, Read) + +instance Binary CompilerInfo + +data AbiTag + = NoAbiTag + | AbiTag String + deriving (Generic, Show, Read) + +instance Binary AbiTag + +instance Text AbiTag where + disp NoAbiTag = Disp.empty + disp (AbiTag tag) = Disp.text tag + + parse = do + tag <- Parse.munch (\c -> Char.isAlphaNum c || c == '_') + if null tag then return NoAbiTag else return (AbiTag tag) + +abiTagString :: AbiTag -> String +abiTagString NoAbiTag = "" +abiTagString (AbiTag tag) = tag + +-- | Make a CompilerInfo of which only the known information is its CompilerId, +-- its AbiTag and that it does not claim to be compatible with other +-- compiler id's. +unknownCompilerInfo :: CompilerId -> AbiTag -> CompilerInfo +unknownCompilerInfo compilerId abiTag = + CompilerInfo compilerId abiTag (Just []) Nothing Nothing diff --git a/Distribution/InstalledPackageInfo.hs b/Distribution/InstalledPackageInfo.hs --- a/Distribution/InstalledPackageInfo.hs +++ b/Distribution/InstalledPackageInfo.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.InstalledPackageInfo @@ -22,40 +24,11 @@ -- textual format is rather simpler than the @.cabal@ format: there are no -- sections, for example. -{- All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of the University nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} - -- This module is meant to be local-only to Distribution... module Distribution.InstalledPackageInfo ( InstalledPackageInfo_(..), InstalledPackageInfo, + OriginalModule(..), ExposedModule(..), ParseResult(..), PError(..), PWarning, emptyInstalledPackageInfo, parseInstalledPackageInfo, @@ -72,29 +45,36 @@ , parseFieldsFlat , parseFilePathQ, parseTokenQ, parseModuleNameQ, parsePackageNameQ , showFilePath, showToken, boolField, parseOptVersion - , parseFreeText, showFreeText ) + , parseFreeText, showFreeText, parseOptCommaList ) import Distribution.License ( License(..) ) import Distribution.Package ( PackageName(..), PackageIdentifier(..) , PackageId, InstalledPackageId(..) - , packageName, packageVersion ) + , packageName, packageVersion, PackageKey(..) ) import qualified Distribution.Package as Package - ( Package(..) ) import Distribution.ModuleName ( ModuleName ) import Distribution.Version ( Version(..) ) import Distribution.Text ( Text(disp, parse) ) +import Text.PrettyPrint as Disp +import qualified Distribution.Compat.ReadP as Parse +import Data.Binary (Binary) +import Data.Maybe (fromMaybe) +import GHC.Generics (Generic) + -- ----------------------------------------------------------------------------- -- The InstalledPackageInfo type + data InstalledPackageInfo_ m = InstalledPackageInfo { -- these parts are exactly the same as PackageDescription installedPackageId :: InstalledPackageId, sourcePackageId :: PackageId, + packageKey :: PackageKey, license :: License, copyright :: String, maintainer :: String, @@ -107,30 +87,38 @@ category :: String, -- these parts are required by an installed package only: exposed :: Bool, - exposedModules :: [m], + exposedModules :: [ExposedModule], + instantiatedWith :: [(m, OriginalModule)], hiddenModules :: [m], trusted :: Bool, - importDirs :: [FilePath], -- contain sources in case of Hugs + importDirs :: [FilePath], libraryDirs :: [FilePath], + dataDir :: FilePath, hsLibraries :: [String], extraLibraries :: [String], extraGHCiLibraries:: [String], -- overrides extraLibraries for GHCi includeDirs :: [FilePath], includes :: [String], depends :: [InstalledPackageId], - hugsOptions :: [String], ccOptions :: [String], ldOptions :: [String], frameworkDirs :: [FilePath], frameworks :: [String], haddockInterfaces :: [FilePath], - haddockHTMLs :: [FilePath] + haddockHTMLs :: [FilePath], + pkgRoot :: Maybe FilePath } - deriving (Read, Show) + deriving (Generic, Read, Show) +instance Binary m => Binary (InstalledPackageInfo_ m) + instance Package.Package (InstalledPackageInfo_ str) where packageId = sourcePackageId +instance Package.PackageInstalled (InstalledPackageInfo_ str) where + installedPackageId = installedPackageId + installedDepends = depends + type InstalledPackageInfo = InstalledPackageInfo_ ModuleName emptyInstalledPackageInfo :: InstalledPackageInfo_ m @@ -138,7 +126,9 @@ = InstalledPackageInfo { installedPackageId = InstalledPackageId "", sourcePackageId = PackageIdentifier (PackageName "") noVersion, - license = AllRightsReserved, + packageKey = OldPackageKey (PackageIdentifier + (PackageName "") noVersion), + license = UnspecifiedLicense, copyright = "", maintainer = "", author = "", @@ -151,34 +141,116 @@ exposed = False, exposedModules = [], hiddenModules = [], + instantiatedWith = [], trusted = False, importDirs = [], libraryDirs = [], + dataDir = "", hsLibraries = [], extraLibraries = [], extraGHCiLibraries= [], includeDirs = [], includes = [], depends = [], - hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = [], - haddockHTMLs = [] + haddockHTMLs = [], + pkgRoot = Nothing } noVersion :: Version -noVersion = Version{ versionBranch=[], versionTags=[] } +noVersion = Version [] [] -- ----------------------------------------------------------------------------- +-- Exposed modules + +data OriginalModule + = OriginalModule { + originalPackageId :: InstalledPackageId, + originalModuleName :: ModuleName + } + deriving (Generic, Eq, Read, Show) + +data ExposedModule + = ExposedModule { + exposedName :: ModuleName, + exposedReexport :: Maybe OriginalModule, + exposedSignature :: Maybe OriginalModule -- This field is unused for now. + } + deriving (Generic, Read, Show) + +instance Text OriginalModule where + disp (OriginalModule ipi m) = + disp ipi <> Disp.char ':' <> disp m + parse = do + ipi <- parse + _ <- Parse.char ':' + m <- parse + return (OriginalModule ipi m) + +instance Text ExposedModule where + disp (ExposedModule m reexport signature) = + Disp.sep [ disp m + , case reexport of + Just m' -> Disp.sep [Disp.text "from", disp m'] + Nothing -> Disp.empty + , case signature of + Just m' -> Disp.sep [Disp.text "is", disp m'] + Nothing -> Disp.empty + ] + parse = do + m <- parseModuleNameQ + Parse.skipSpaces + reexport <- Parse.option Nothing $ do + _ <- Parse.string "from" + Parse.skipSpaces + fmap Just parse + Parse.skipSpaces + signature <- Parse.option Nothing $ do + _ <- Parse.string "is" + Parse.skipSpaces + fmap Just parse + return (ExposedModule m reexport signature) + + +instance Binary OriginalModule + +instance Binary ExposedModule + +-- To maintain backwards-compatibility, we accept both comma/non-comma +-- separated variants of this field. You SHOULD use the comma syntax if you +-- use any new functions, although actually it's unambiguous due to a quirk +-- of the fact that modules must start with capital letters. + +showExposedModules :: [ExposedModule] -> Disp.Doc +showExposedModules xs + | all isExposedModule xs = fsep (map disp xs) + | otherwise = fsep (Disp.punctuate comma (map disp xs)) + where isExposedModule (ExposedModule _ Nothing Nothing) = True + isExposedModule _ = False + +parseExposedModules :: Parse.ReadP r [ExposedModule] +parseExposedModules = parseOptCommaList parse + +-- ----------------------------------------------------------------------------- -- Parsing parseInstalledPackageInfo :: String -> ParseResult InstalledPackageInfo parseInstalledPackageInfo = - parseFieldsFlat fieldsInstalledPackageInfo emptyInstalledPackageInfo + parseFieldsFlat (fieldsInstalledPackageInfo ++ deprecatedFieldDescrs) + emptyInstalledPackageInfo +parseInstantiatedWith :: Parse.ReadP r (ModuleName, OriginalModule) +parseInstantiatedWith = do k <- parse + _ <- Parse.char '=' + n <- parse + _ <- Parse.char '@' + p <- parse + return (k, OriginalModule p n) + -- ----------------------------------------------------------------------------- -- Pretty-printing @@ -191,6 +263,9 @@ showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String) showSimpleInstalledPackageInfoField = showSimpleSingleNamedField fieldsInstalledPackageInfo +showInstantiatedWith :: (ModuleName, OriginalModule) -> Doc +showInstantiatedWith (k, OriginalModule p m) = disp k <> text "=" <> disp m <> text "@" <> disp p + -- ----------------------------------------------------------------------------- -- Description of the fields, for parsing/printing @@ -208,6 +283,9 @@ , simpleField "id" disp parse installedPackageId (\ipid pkg -> pkg{installedPackageId=ipid}) + , simpleField "key" + disp parse + packageKey (\ipid pkg -> pkg{packageKey=ipid}) , simpleField "license" disp parseLicenseQ license (\l pkg -> pkg{license=l}) @@ -244,12 +322,15 @@ installedFieldDescrs = [ boolField "exposed" exposed (\val pkg -> pkg{exposed=val}) - , listField "exposed-modules" - disp parseModuleNameQ + , simpleField "exposed-modules" + showExposedModules parseExposedModules exposedModules (\xs pkg -> pkg{exposedModules=xs}) , listField "hidden-modules" disp parseModuleNameQ hiddenModules (\xs pkg -> pkg{hiddenModules=xs}) + , listField "instantiated-with" + showInstantiatedWith parseInstantiatedWith + instantiatedWith (\xs pkg -> pkg{instantiatedWith=xs}) , boolField "trusted" trusted (\val pkg -> pkg{trusted=val}) , listField "import-dirs" @@ -258,6 +339,9 @@ , listField "library-dirs" showFilePath parseFilePathQ libraryDirs (\xs pkg -> pkg{libraryDirs=xs}) + , simpleField "data-dir" + showFilePath (parseFilePathQ Parse.<++ return "") + dataDir (\val pkg -> pkg{dataDir=val}) , listField "hs-libraries" showFilePath parseTokenQ hsLibraries (\xs pkg -> pkg{hsLibraries=xs}) @@ -276,9 +360,6 @@ , listField "depends" disp parse depends (\xs pkg -> pkg{depends=xs}) - , listField "hugs-options" - showToken parseTokenQ - hugsOptions (\path pkg -> pkg{hugsOptions=path}) , listField "cc-options" showToken parseTokenQ ccOptions (\path pkg -> pkg{ccOptions=path}) @@ -297,4 +378,14 @@ , listField "haddock-html" showFilePath parseFilePathQ haddockHTMLs (\xs pkg -> pkg{haddockHTMLs=xs}) + , simpleField "pkgroot" + (const Disp.empty) parseFilePathQ + (fromMaybe "" . pkgRoot) (\xs pkg -> pkg{pkgRoot=Just xs}) ] + +deprecatedFieldDescrs :: [FieldDescr InstalledPackageInfo] +deprecatedFieldDescrs = [ + listField "hugs-options" + showToken parseTokenQ + (const []) (const id) + ] diff --git a/Distribution/License.hs b/Distribution/License.hs --- a/Distribution/License.hs +++ b/Distribution/License.hs @@ -1,4 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.License @@ -51,9 +53,11 @@ import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp import Text.PrettyPrint ((<>)) +import Data.Binary (Binary) import qualified Data.Char as Char (isAlphaNum) import Data.Data (Data) import Data.Typeable (Typeable) +import GHC.Generics (Generic) -- | Indicates the license under which a package's source code is released. -- Versions of the licenses not listed here will be rejected by Hackage and @@ -88,6 +92,9 @@ -- | . | MIT + -- | + | ISC + -- | . | MPL Version @@ -101,23 +108,31 @@ -- jurisdiction necessarily in the public domain elsewhere. | PublicDomain - -- | No license. The package may not be legally modified or redistributed by - -- anyone but the rightsholder. + -- | Explicitly 'All Rights Reserved', eg for proprietary software. The + -- package may not be legally modified or redistributed by anyone but the + -- rightsholder. | AllRightsReserved + -- | No license specified which legally defaults to 'All Rights Reserved'. + -- The package may not be legally modified or redistributed by anyone but + -- the rightsholder. + | UnspecifiedLicense + -- | Any other software license. | OtherLicense -- | Indicates an erroneous license name. | UnknownLicense String - deriving (Read, Show, Eq, Typeable, Data) + deriving (Generic, Read, Show, Eq, Typeable, Data) +instance Binary License + -- | The list of all currently recognised licenses. knownLicenses :: [License] knownLicenses = [ GPL unversioned, GPL (version [2]), GPL (version [3]) , LGPL unversioned, LGPL (version [2, 1]), LGPL (version [3]) , AGPL unversioned, AGPL (version [3]) - , BSD2, BSD3, MIT + , BSD2, BSD3, MIT, ISC , MPL (Version [2, 0] []) , Apache unversioned, Apache (version [2, 0]) , PublicDomain, AllRightsReserved, OtherLicense] @@ -144,6 +159,7 @@ ("BSD2", Nothing) -> BSD2 ("BSD3", Nothing) -> BSD3 ("BSD4", Nothing) -> BSD4 + ("ISC", Nothing) -> ISC ("MIT", Nothing) -> MIT ("MPL", Just version') -> MPL version' ("Apache", _ ) -> Apache version diff --git a/Distribution/Make.hs b/Distribution/Make.hs --- a/Distribution/Make.hs +++ b/Distribution/Make.hs @@ -92,7 +92,7 @@ defaultMainHelper :: [String] -> IO () defaultMainHelper args = - case commandsRun globalCommand commands args of + case commandsRun (globalCommand commands) commands args of CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs diff --git a/Distribution/ModuleName.hs b/Distribution/ModuleName.hs --- a/Distribution/ModuleName.hs +++ b/Distribution/ModuleName.hs @@ -1,4 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.ModuleName @@ -22,21 +24,25 @@ import Distribution.Text ( Text(..) ) +import Data.Binary (Binary) +import qualified Data.Char as Char + ( isAlphaNum, isUpper ) import Data.Data (Data) import Data.Typeable (Typeable) import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp -import qualified Data.Char as Char - ( isAlphaNum, isUpper ) -import System.FilePath - ( pathSeparator ) import Data.List ( intercalate, intersperse ) +import GHC.Generics (Generic) +import System.FilePath + ( pathSeparator ) -- | A valid Haskell module name. -- newtype ModuleName = ModuleName [String] - deriving (Eq, Ord, Read, Show, Typeable, Data) + deriving (Eq, Generic, Ord, Read, Show, Typeable, Data) + +instance Binary ModuleName instance Text ModuleName where disp (ModuleName ms) = diff --git a/Distribution/Package.hs b/Distribution/Package.hs --- a/Distribution/Package.hs +++ b/Distribution/Package.hs @@ -1,4 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.Package @@ -22,6 +24,10 @@ -- * Installed package identifiers InstalledPackageId(..), + -- * Package keys (used for linker symbols) + PackageKey(..), + mkPackageKey, + -- * Package source dependencies Dependency(..), thisPackageVersion, @@ -31,8 +37,10 @@ -- * Package classes Package(..), packageName, packageVersion, PackageFixedDeps(..), + PackageInstalled(..), ) where +import Distribution.ModuleName ( ModuleName ) import Distribution.Version ( Version(..), VersionRange, anyVersion, thisVersion , notThisVersion, simplifyVersionRange ) @@ -41,16 +49,25 @@ import qualified Distribution.Compat.ReadP as Parse import Distribution.Compat.ReadP ((<++)) import qualified Text.PrettyPrint as Disp -import Text.PrettyPrint ((<>), (<+>), text) + import Control.DeepSeq (NFData(..)) -import qualified Data.Char as Char ( isDigit, isAlphaNum ) -import Data.List ( intercalate ) +import Data.Binary (Binary) +import qualified Data.Char as Char + ( isDigit, isAlphaNum, isUpper, isLower, ord, chr ) import Data.Data ( Data ) +import Data.List ( intercalate, sort, foldl' ) import Data.Typeable ( Typeable ) +import Data.Word ( Word64 ) +import GHC.Fingerprint ( Fingerprint(..), fingerprintString ) +import GHC.Generics (Generic) +import Numeric ( showIntAtBase ) +import Text.PrettyPrint ((<>), (<+>), text) -newtype PackageName = PackageName String - deriving (Read, Show, Eq, Ord, Typeable, Data) +newtype PackageName = PackageName { unPackageName :: String } + deriving (Generic, Read, Show, Eq, Ord, Typeable, Data) +instance Binary PackageName + instance Text PackageName where disp (PackageName n) = Disp.text n parse = do @@ -75,8 +92,10 @@ pkgName :: PackageName, -- ^The name of this package, eg. foo pkgVersion :: Version -- ^the version of this package, eg 1.2 } - deriving (Read, Show, Eq, Ord, Typeable, Data) + deriving (Generic, Read, Show, Eq, Ord, Typeable, Data) +instance Binary PackageIdentifier + instance Text PackageIdentifier where disp (PackageIdentifier n v) = case v of Version [] _ -> disp n -- if no version, don't show version. @@ -99,23 +118,139 @@ -- in a package database, or overlay of databases. -- newtype InstalledPackageId = InstalledPackageId String - deriving (Read,Show,Eq,Ord,Typeable,Data) + deriving (Generic, Read,Show,Eq,Ord,Typeable,Data) +instance Binary InstalledPackageId + instance Text InstalledPackageId where disp (InstalledPackageId str) = text str parse = InstalledPackageId `fmap` Parse.munch1 abi_char - where abi_char c = Char.isAlphaNum c || c `elem` ":-_." + where abi_char c = Char.isAlphaNum c || c `elem` "-_." -- ------------------------------------------------------------ +-- * Package Keys +-- ------------------------------------------------------------ + +-- | A 'PackageKey' is the notion of "package ID" which is visible to the +-- compiler. Why is this not a 'PackageId'? The 'PackageId' is a user-visible +-- concept written explicity in Cabal files; on the other hand, a 'PackageKey' +-- may contain, for example, information about the transitive dependency +-- tree of a package. Why is this not an 'InstalledPackageId'? A 'PackageKey' +-- affects the ABI because it is used for linker symbols; however, an +-- 'InstalledPackageId' can be used to distinguish two ABI-compatible versions +-- of a library. +data PackageKey + -- | Modern package key which is a hash of the PackageId and the transitive + -- dependency key. Manually inline it here so we can get the instances + -- we need. Also contains a short informative string + = PackageKey !String {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 + -- | Old-style package key which is just a 'PackageId'. Required because + -- old versions of GHC assume that the 'sourcePackageId' recorded for an + -- installed package coincides with the package key it was compiled with. + | OldPackageKey !PackageId + deriving (Generic, Read, Show, Eq, Ord, Typeable, Data) + +instance Binary PackageKey + +-- | Convenience function which converts a fingerprint into a new-style package +-- key. +fingerprintPackageKey :: String -> Fingerprint -> PackageKey +fingerprintPackageKey s (Fingerprint a b) = PackageKey s a b + +-- | Generates a 'PackageKey' from a 'PackageId', sorted package keys of the +-- immediate dependencies. +mkPackageKey :: Bool -- are modern style package keys supported? + -> PackageId + -> [PackageKey] -- dependencies + -> [(ModuleName, (PackageKey, ModuleName))] -- hole instantiations + -> PackageKey +mkPackageKey True pid deps holes = fingerprintPackageKey stubName + . fingerprintString + . ((show pid ++ "\n") ++) + . ((show (sort holes) ++ "\n") ++) + $ show (sort deps) + where stubName = take 5 (filter (/= '-') (unPackageName (pkgName pid))) +mkPackageKey False pid _ _ = OldPackageKey pid + +-- The base-62 code is based off of 'locators' +-- ((c) Operational Dynamics Consulting, BSD3 licensed) + +-- Note: Instead of base-62 encoding a single 128-bit integer +-- (ceil(21.49) characters), we'll base-62 a pair of 64-bit integers +-- (2 * ceil(10.75) characters). Luckily for us, it's the same number of +-- characters! In the long term, this should go in GHC.Fingerprint, +-- but not now... + +-- | Size of a 64-bit word when written as a base-62 string +word64Base62Len :: Int +word64Base62Len = 11 + +-- | Converts a 64-bit word into a base-62 string +toBase62 :: Word64 -> String +toBase62 w = pad ++ str + where + pad = replicate len '0' + len = word64Base62Len - length str -- 11 == ceil(64 / lg 62) + str = showIntAtBase 62 represent w "" + represent :: Int -> Char + represent x + | x < 10 = Char.chr (48 + x) + | x < 36 = Char.chr (65 + x - 10) + | x < 62 = Char.chr (97 + x - 36) + | otherwise = error ("represent (base 62): impossible!") + +-- | Parses a base-62 string into a 64-bit word +fromBase62 :: String -> Word64 +fromBase62 ss = foldl' multiply 0 ss + where + value :: Char -> Int + value c + | Char.isDigit c = Char.ord c - 48 + | Char.isUpper c = Char.ord c - 65 + 10 + | Char.isLower c = Char.ord c - 97 + 36 + | otherwise = error ("value (base 62): impossible!") + + multiply :: Word64 -> Char -> Word64 + multiply acc c = acc * 62 + (fromIntegral $ value c) + +-- | Parses a base-62 string into a fingerprint. +readBase62Fingerprint :: String -> Fingerprint +readBase62Fingerprint s = Fingerprint w1 w2 + where (s1,s2) = splitAt word64Base62Len s + w1 = fromBase62 s1 + w2 = fromBase62 (take word64Base62Len s2) + +instance Text PackageKey where + disp (PackageKey prefix w1 w2) = Disp.text prefix <> Disp.char '_' + <> Disp.text (toBase62 w1) <> Disp.text (toBase62 w2) + disp (OldPackageKey pid) = disp pid + + parse = parseNew <++ parseOld + where parseNew = do + prefix <- Parse.munch1 (\c -> Char.isAlphaNum c || c `elem` "-") + _ <- Parse.char '_' -- if we use '-' it's ambiguous + fmap (fingerprintPackageKey prefix . readBase62Fingerprint) + . Parse.count (word64Base62Len * 2) + $ Parse.satisfy Char.isAlphaNum + parseOld = do pid <- parse + return (OldPackageKey pid) + +instance NFData PackageKey where + rnf (PackageKey prefix _ _) = rnf prefix + rnf (OldPackageKey pid) = rnf pid + +-- ------------------------------------------------------------ -- * Package source dependencies -- ------------------------------------------------------------ -- | Describes a dependency on a source package (API) -- data Dependency = Dependency PackageName VersionRange - deriving (Read, Show, Eq, Typeable, Data) + deriving (Generic, Read, Show, Eq, Typeable, Data) +instance Binary Dependency + instance Text Dependency where disp (Dependency name ver) = disp name <+> disp ver @@ -172,3 +307,13 @@ -- class Package pkg => PackageFixedDeps pkg where depends :: pkg -> [PackageIdentifier] + +-- | Class of installed packages. +-- +-- The primary data type which is an instance of this package is +-- 'InstalledPackageInfo', but when we are doing install plans in Cabal install +-- we may have other, installed package-like things which contain more metadata. +-- Installed packages have exact dependencies 'installedDepends'. +class Package pkg => PackageInstalled pkg where + installedPackageId :: pkg -> InstalledPackageId + installedDepends :: pkg -> [InstalledPackageId] diff --git a/Distribution/PackageDescription.hs b/Distribution/PackageDescription.hs --- a/Distribution/PackageDescription.hs +++ b/Distribution/PackageDescription.hs @@ -1,4 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.PackageDescription @@ -31,8 +33,14 @@ BuildType(..), knownBuildTypes, + -- ** Renaming + ModuleRenaming(..), + defaultRenaming, + lookupRenaming, + -- ** Libraries Library(..), + ModuleReexport(..), emptyLibrary, withLib, hasLibs, @@ -77,6 +85,8 @@ allExtensions, usedExtensions, hcOptions, + hcProfOptions, + hcSharedOptions, -- ** Supplementary build information HookedBuildInfo, @@ -95,24 +105,29 @@ knownRepoTypes, ) where +import Data.Binary (Binary) import Data.Data (Data) import Data.List (nub, intercalate) import Data.Maybe (fromMaybe, maybeToList) import Data.Monoid (Monoid(mempty, mappend)) import Data.Typeable ( Typeable ) import Control.Monad (MonadPlus(mplus)) +import GHC.Generics (Generic) import Text.PrettyPrint as Disp import qualified Distribution.Compat.ReadP as Parse +import Distribution.Compat.ReadP ((<++)) import qualified Data.Char as Char (isAlphaNum, isDigit, toLower) +import qualified Data.Map as Map +import Data.Map (Map) import Distribution.Package ( PackageName(PackageName), PackageIdentifier(PackageIdentifier) - , Dependency, Package(..) ) + , Dependency, Package(..), PackageName, packageName ) import Distribution.ModuleName ( ModuleName ) import Distribution.Version ( Version(Version), VersionRange, anyVersion, orLaterVersion , asVersionIntervals, LowerBound(..) ) -import Distribution.License (License(AllRightsReserved)) +import Distribution.License (License(UnspecifiedLicense)) import Distribution.Compiler (CompilerFlavor) import Distribution.System (OS, Arch) import Distribution.Text @@ -150,6 +165,17 @@ customFieldsPD :: [(String,String)], -- ^Custom fields starting -- with x-, stored in a -- simple assoc-list. + -- | YOU PROBABLY DON'T WANT TO USE THIS FIELD. This field is + -- special! Depending on how far along processing the + -- PackageDescription we are, the contents of this field are + -- either nonsense, or the collected dependencies of *all* the + -- components in this package. buildDepends is initialized by + -- 'finalizePackageDescription' and 'flattenPackageDescription'; + -- prior to that, dependency info is stored in the 'CondTree' + -- built around a 'GenericPackageDescription'. When this + -- resolution is done, dependency info is written to the inner + -- 'BuildInfo' and this field. This is all horrible, and #2066 + -- tracks progress to get rid of this field. buildDepends :: [Dependency], -- | The version of the Cabal spec that this package description uses. -- For historical reasons this is specified with a version range but @@ -168,8 +194,10 @@ extraTmpFiles :: [FilePath], extraDocFiles :: [FilePath] } - deriving (Show, Read, Eq, Typeable, Data) + deriving (Generic, Show, Read, Eq, Typeable, Data) +instance Binary PackageDescription + instance Package PackageDescription where packageId = package @@ -204,7 +232,7 @@ = PackageDescription { package = PackageIdentifier (PackageName "") (Version [] []), - license = AllRightsReserved, + license = UnspecifiedLicense, licenseFiles = [], specVersionRaw = Right anyVersion, buildType = Nothing, @@ -246,8 +274,10 @@ -- be built. Doing it this way rather than just giving a -- parse error means we get better error messages and allows -- you to inspect the rest of the package description. - deriving (Show, Read, Eq, Typeable, Data) + deriving (Generic, Show, Read, Eq, Typeable, Data) +instance Binary BuildType + knownBuildTypes :: [BuildType] knownBuildTypes = [Simple, Configure, Make, Custom] @@ -265,23 +295,96 @@ _ -> UnknownBuildType name -- --------------------------------------------------------------------------- +-- Module renaming + +-- | Renaming applied to the modules provided by a package. +-- The boolean indicates whether or not to also include all of the +-- original names of modules. Thus, @ModuleRenaming False []@ is +-- "don't expose any modules, and @ModuleRenaming True [("Data.Bool", "Bool")]@ +-- is, "expose all modules, but also expose @Data.Bool@ as @Bool@". +-- +data ModuleRenaming = ModuleRenaming Bool [(ModuleName, ModuleName)] + deriving (Show, Read, Eq, Ord, Typeable, Data, Generic) + +defaultRenaming :: ModuleRenaming +defaultRenaming = ModuleRenaming True [] + +lookupRenaming :: Package pkg => pkg -> Map PackageName ModuleRenaming -> ModuleRenaming +lookupRenaming pkg rns = + Map.findWithDefault + (error ("lookupRenaming: missing renaming for " ++ display (packageName pkg))) + (packageName pkg) rns + +instance Binary ModuleRenaming where + +instance Monoid ModuleRenaming where + ModuleRenaming b rns `mappend` ModuleRenaming b' rns' + = ModuleRenaming (b || b') (rns ++ rns') -- ToDo: dedupe? + mempty = ModuleRenaming False [] + +-- NB: parentheses are mandatory, because later we may extend this syntax +-- to allow "hiding (A, B)" or other modifier words. +instance Text ModuleRenaming where + disp (ModuleRenaming True []) = Disp.empty + disp (ModuleRenaming b vs) = (if b then text "with" else Disp.empty) <+> dispRns + where dispRns = Disp.parens + (Disp.hsep + (Disp.punctuate Disp.comma (map dispEntry vs))) + dispEntry (orig, new) + | orig == new = disp orig + | otherwise = disp orig <+> text "as" <+> disp new + + parse = do Parse.string "with" >> Parse.skipSpaces + fmap (ModuleRenaming True) parseRns + <++ fmap (ModuleRenaming False) parseRns + <++ return (ModuleRenaming True []) + where parseRns = do + rns <- Parse.between (Parse.char '(') (Parse.char ')') parseList + Parse.skipSpaces + return rns + parseList = + Parse.sepBy parseEntry (Parse.char ',' >> Parse.skipSpaces) + parseEntry :: Parse.ReadP r (ModuleName, ModuleName) + parseEntry = do + orig <- parse + Parse.skipSpaces + (do _ <- Parse.string "as" + Parse.skipSpaces + new <- parse + Parse.skipSpaces + return (orig, new) + <++ + return (orig, orig)) + +-- --------------------------------------------------------------------------- -- The Library type data Library = Library { exposedModules :: [ModuleName], + reexportedModules :: [ModuleReexport], + requiredSignatures:: [ModuleName], -- ^ What sigs need implementations? + exposedSignatures:: [ModuleName], -- ^ What sigs are visible to users? libExposed :: Bool, -- ^ Is the lib to be exposed by default? libBuildInfo :: BuildInfo } - deriving (Show, Eq, Read, Typeable, Data) + deriving (Generic, Show, Eq, Read, Typeable, Data) +instance Binary Library + instance Monoid Library where mempty = Library { exposedModules = mempty, + reexportedModules = mempty, + requiredSignatures = mempty, + exposedSignatures = mempty, libExposed = True, libBuildInfo = mempty } mappend a b = Library { exposedModules = combine exposedModules, + reexportedModules = combine reexportedModules, + requiredSignatures = combine requiredSignatures, + exposedSignatures = combine exposedSignatures, libExposed = libExposed a && libExposed b, -- so False propagates libBuildInfo = combine libBuildInfo } @@ -308,10 +411,47 @@ maybe (return ()) f (maybeHasLibs pkg_descr) -- | Get all the module names from the library (exposed and internal modules) +-- which need to be compiled. (This does not include reexports, which +-- do not need to be compiled.) libModules :: Library -> [ModuleName] libModules lib = exposedModules lib ++ otherModules (libBuildInfo lib) + ++ exposedSignatures lib + ++ requiredSignatures lib +-- ----------------------------------------------------------------------------- +-- Module re-exports + +data ModuleReexport = ModuleReexport { + moduleReexportOriginalPackage :: Maybe PackageName, + moduleReexportOriginalName :: ModuleName, + moduleReexportName :: ModuleName + } + deriving (Eq, Generic, Read, Show, Typeable, Data) + +instance Binary ModuleReexport + +instance Text ModuleReexport where + disp (ModuleReexport mpkgname origname newname) = + maybe Disp.empty (\pkgname -> disp pkgname <> Disp.char ':') mpkgname + <> disp origname + <+> if newname == origname + then Disp.empty + else Disp.text "as" <+> disp newname + + parse = do + mpkgname <- Parse.option Nothing $ do + pkgname <- parse + _ <- Parse.char ':' + return (Just pkgname) + origname <- parse + newname <- Parse.option origname $ do + Parse.skipSpaces + _ <- Parse.string "as" + Parse.skipSpaces + parse + return (ModuleReexport mpkgname origname newname) + -- --------------------------------------------------------------------------- -- The Executable type @@ -320,8 +460,10 @@ modulePath :: FilePath, buildInfo :: BuildInfo } - deriving (Show, Read, Eq, Typeable, Data) + deriving (Generic, Show, Read, Eq, Typeable, Data) +instance Binary Executable + instance Monoid Executable where mempty = Executable { exeName = mempty, @@ -374,8 +516,10 @@ -- a better solution is waiting on the next overhaul to the -- GenericPackageDescription -> PackageDescription resolution process. } - deriving (Show, Read, Eq, Typeable, Data) + deriving (Generic, Show, Read, Eq, Typeable, Data) +instance Binary TestSuite + -- | The test suite interfaces that are currently defined. Each test suite must -- specify which interface it supports. -- @@ -400,8 +544,10 @@ -- the given reason (e.g. unknown test type). -- | TestSuiteUnsupported TestType - deriving (Eq, Read, Show, Typeable, Data) + deriving (Eq, Generic, Read, Show, Typeable, Data) +instance Binary TestSuiteInterface + instance Monoid TestSuite where mempty = TestSuite { testName = mempty, @@ -456,8 +602,10 @@ data TestType = TestTypeExe Version -- ^ \"type: exitcode-stdio-x.y\" | TestTypeLib Version -- ^ \"type: detailed-x.y\" | TestTypeUnknown String Version -- ^ Some unknown test type e.g. \"type: foo\" - deriving (Show, Read, Eq, Typeable, Data) + deriving (Generic, Show, Read, Eq, Typeable, Data) +instance Binary TestType + knownTestTypes :: [TestType] knownTestTypes = [ TestTypeExe (Version [1,0] []) , TestTypeLib (Version [0,9] []) ] @@ -505,8 +653,10 @@ benchmarkEnabled :: Bool -- TODO: See TODO for 'testEnabled'. } - deriving (Show, Read, Eq, Typeable, Data) + deriving (Generic, Show, Read, Eq, Typeable, Data) +instance Binary Benchmark + -- | The benchmark interfaces that are currently defined. Each -- benchmark must specify which interface it supports. -- @@ -527,8 +677,10 @@ -- interfaces for the given reason (e.g. unknown benchmark type). -- | BenchmarkUnsupported BenchmarkType - deriving (Eq, Read, Show, Typeable, Data) + deriving (Eq, Generic, Read, Show, Typeable, Data) +instance Binary BenchmarkInterface + instance Monoid Benchmark where mempty = Benchmark { benchmarkName = mempty, @@ -581,8 +733,10 @@ -- ^ \"type: exitcode-stdio-x.y\" | BenchmarkTypeUnknown String Version -- ^ Some unknown benchmark type e.g. \"type: foo\" - deriving (Show, Read, Eq, Typeable, Data) + deriving (Generic, Show, Read, Eq, Typeable, Data) +instance Binary BenchmarkType + knownBenchmarkTypes :: [BenchmarkType] knownBenchmarkTypes = [ BenchmarkTypeExe (Version [1,0] []) ] @@ -613,6 +767,7 @@ pkgconfigDepends :: [Dependency], -- ^ pkg-config packages that are used frameworks :: [String], -- ^support frameworks for Mac OS X cSources :: [FilePath], + jsSources :: [FilePath], hsSourceDirs :: [FilePath], -- ^ where to look for the Haskell module hierarchy otherModules :: [ModuleName], -- ^ non-exposed or non-main modules @@ -623,20 +778,24 @@ oldExtensions :: [Extension], -- ^ the old extensions field, treated same as 'defaultExtensions' extraLibs :: [String], -- ^ what libraries to link with when compiling a program that uses your package + extraGHCiLibs :: [String], -- ^ if present, overrides extraLibs when package is loaded with GHCi. extraLibDirs :: [String], includeDirs :: [FilePath], -- ^directories to find .h files includes :: [FilePath], -- ^ The .h files to be found in includeDirs installIncludes :: [FilePath], -- ^ .h files to install with the package options :: [(CompilerFlavor,[String])], - ghcProfOptions :: [String], - ghcSharedOptions :: [String], + profOptions :: [(CompilerFlavor,[String])], + sharedOptions :: [(CompilerFlavor,[String])], customFieldsBI :: [(String,String)], -- ^Custom fields starting -- with x-, stored in a -- simple assoc-list. - targetBuildDepends :: [Dependency] -- ^ Dependencies specific to a library or executable target + targetBuildDepends :: [Dependency], -- ^ Dependencies specific to a library or executable target + targetBuildRenaming :: Map PackageName ModuleRenaming } - deriving (Show,Read,Eq,Typeable,Data) + deriving (Generic, Show, Read, Eq, Typeable, Data) +instance Binary BuildInfo + instance Monoid BuildInfo where mempty = BuildInfo { buildable = True, @@ -647,6 +806,7 @@ pkgconfigDepends = [], frameworks = [], cSources = [], + jsSources = [], hsSourceDirs = [], otherModules = [], defaultLanguage = Nothing, @@ -655,15 +815,17 @@ otherExtensions = [], oldExtensions = [], extraLibs = [], + extraGHCiLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [], - ghcProfOptions = [], - ghcSharedOptions = [], + profOptions = [], + sharedOptions = [], customFieldsBI = [], - targetBuildDepends = [] + targetBuildDepends = [], + targetBuildRenaming = Map.empty } mappend a b = BuildInfo { buildable = buildable a && buildable b, @@ -674,6 +836,7 @@ pkgconfigDepends = combine pkgconfigDepends, frameworks = combineNub frameworks, cSources = combineNub cSources, + jsSources = combineNub jsSources, hsSourceDirs = combineNub hsSourceDirs, otherModules = combineNub otherModules, defaultLanguage = combineMby defaultLanguage, @@ -682,20 +845,23 @@ 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, - ghcProfOptions = combine ghcProfOptions, - ghcSharedOptions = combine ghcSharedOptions, + profOptions = combine profOptions, + sharedOptions = combine sharedOptions, customFieldsBI = combine customFieldsBI, - targetBuildDepends = combineNub targetBuildDepends + targetBuildDepends = combineNub targetBuildDepends, + targetBuildRenaming = combineMap targetBuildRenaming } where combine field = field a `mappend` field b combineNub field = nub (combine field) combineMby field = field b `mplus` field a + combineMap field = Map.unionWith mappend (field a) (field b) emptyBuildInfo :: BuildInfo emptyBuildInfo = mempty @@ -746,10 +912,20 @@ -- |Select options for a particular Haskell compiler. hcOptions :: CompilerFlavor -> BuildInfo -> [String] -hcOptions hc bi = [ opt | (hc',opts) <- options bi - , hc' == hc - , opt <- opts ] +hcOptions = lookupHcOptions options +hcProfOptions :: CompilerFlavor -> BuildInfo -> [String] +hcProfOptions = lookupHcOptions profOptions + +hcSharedOptions :: CompilerFlavor -> BuildInfo -> [String] +hcSharedOptions = lookupHcOptions sharedOptions + +lookupHcOptions :: (BuildInfo -> [(CompilerFlavor,[String])]) + -> CompilerFlavor -> BuildInfo -> [String] +lookupHcOptions f hc bi = [ opt | (hc',opts) <- f bi + , hc' == hc + , opt <- opts ] + -- ------------------------------------------------------------ -- * Source repos -- ------------------------------------------------------------ @@ -809,8 +985,10 @@ -- given the default is \".\" ie no subdirectory. repoSubdir :: Maybe FilePath } - deriving (Eq, Read, Show, Typeable, Data) + deriving (Eq, Generic, Read, Show, Typeable, Data) +instance Binary SourceRepo + -- | What this repo info is for, what it represents. -- data RepoKind = @@ -825,8 +1003,10 @@ | RepoThis | RepoKindUnknown String - deriving (Eq, Ord, Read, Show, Typeable, Data) + deriving (Eq, Generic, Ord, Read, Show, Typeable, Data) +instance Binary RepoKind + -- | An enumeration of common source control systems. The fields used in the -- 'SourceRepo' depend on the type of repo. The tools and methods used to -- obtain and track the repo depend on the repo type. @@ -834,8 +1014,10 @@ data RepoType = Darcs | Git | SVN | CVS | Mercurial | GnuArch | Bazaar | Monotone | OtherRepoType String - deriving (Eq, Ord, Read, Show, Typeable, Data) + deriving (Eq, Generic, Ord, Read, Show, Typeable, Data) +instance Binary RepoType + knownRepoTypes :: [RepoType] knownRepoTypes = [Darcs, Git, SVN, CVS ,Mercurial, GnuArch, Bazaar, Monotone] @@ -936,8 +1118,10 @@ -- | A 'FlagName' is the name of a user-defined configuration flag newtype FlagName = FlagName String - deriving (Eq, Ord, Show, Read, Typeable, Data) + deriving (Eq, Generic, Ord, Show, Read, Typeable, Data) +instance Binary FlagName + -- | A 'FlagAssignment' is a total or partial mapping of 'FlagName's to -- 'Bool' flag values. It represents the flags chosen by the user or -- discovered during configuration. For example @--flags=foo --flags=-bar@ @@ -952,13 +1136,6 @@ | Impl CompilerFlavor VersionRange deriving (Eq, Show, Typeable, Data) ---instance Text ConfVar where --- disp (OS os) = "os(" ++ display os ++ ")" --- disp (Arch arch) = "arch(" ++ display arch ++ ")" --- disp (Flag (ConfFlag f)) = "flag(" ++ f ++ ")" --- disp (Impl c v) = "impl(" ++ display c --- ++ " " ++ display v ++ ")" - -- | A boolean expression parameterized over the variable type used. data Condition c = Var c | Lit Bool @@ -967,13 +1144,6 @@ | CAnd (Condition c) (Condition c) deriving (Show, Eq, Typeable, Data) ---instance Text c => Text (Condition c) where --- disp (Var x) = text (show x) --- disp (Lit b) = text (show b) --- disp (CNot c) = char '!' <> parens (ppCond c) --- disp (COr c1 c2) = parens $ sep [ppCond c1, text "||" <+> ppCond c2] --- disp (CAnd c1 c2) = parens $ sep [ppCond c1, text "&&" <+> ppCond c2] - data CondTree v c a = CondNode { condTreeData :: a , condTreeConstraints :: c @@ -982,16 +1152,3 @@ , Maybe (CondTree v c a))] } deriving (Show, Eq, Typeable, Data) - ---instance (Text v, Text c) => Text (CondTree v c a) where --- disp (CondNode _dat cs ifs) = --- (text "build-depends: " <+> --- disp cs) --- $+$ --- (vcat $ map ppIf ifs) --- where --- ppIf (c,thenTree,mElseTree) = --- ((text "if" <+> ppCond c <> colon) $$ --- nest 2 (ppCondTree thenTree disp)) --- $+$ (maybe empty (\t -> text "else: " $$ nest 2 (ppCondTree t disp)) --- mElseTree) diff --git a/Distribution/PackageDescription/Check.hs b/Distribution/PackageDescription/Check.hs --- a/Distribution/PackageDescription/Check.hs +++ b/Distribution/PackageDescription/Check.hs @@ -40,12 +40,14 @@ ( filterM, liftM ) import qualified System.Directory as System ( doesFileExist, doesDirectoryExist ) +import qualified Data.Map as Map import Distribution.PackageDescription import Distribution.PackageDescription.Configuration ( flattenPackageDescription, finalizePackageDescription ) import Distribution.Compiler - ( CompilerFlavor(..), buildCompilerFlavor, CompilerId(..) ) + ( CompilerFlavor(..), buildCompilerFlavor, CompilerId(..) + , unknownCompilerInfo, AbiTag(..) ) import Distribution.System ( OS(..), Arch(..), buildPlatform ) import Distribution.License @@ -73,7 +75,8 @@ import qualified Language.Haskell.Extension as Extension (deprecatedExtensions) import Language.Haskell.Extension - ( Language(UnknownLanguage), knownLanguages, Extension(..), KnownExtension(..) ) + ( Language(UnknownLanguage), knownLanguages + , Extension(..), KnownExtension(..) ) import System.FilePath ( (), takeExtension, isRelative, isAbsolute , splitDirectories, splitPath ) @@ -119,7 +122,8 @@ check False _ = Nothing check True pc = Just pc -checkSpecVersion :: PackageDescription -> [Int] -> Bool -> PackageCheck -> Maybe PackageCheck +checkSpecVersion :: PackageDescription -> [Int] -> Bool -> PackageCheck + -> Maybe PackageCheck checkSpecVersion pkg specver cond pc | specVersion pkg >= Version specver [] = Nothing | otherwise = check cond pc @@ -189,7 +193,8 @@ ++ ". The name of every executable, test suite, and benchmark section in" ++ " the package must be unique." ] - --TODO: check for name clashes case insensitively: windows file systems cannot cope. + --TODO: check for name clashes case insensitively: windows file systems cannot + --cope. ++ maybe [] (checkLibrary pkg) (library pkg) ++ concatMap (checkExecutable pkg) (executables pkg) @@ -211,18 +216,35 @@ duplicateNames = dups $ exeNames ++ testNames ++ bmNames checkLibrary :: PackageDescription -> Library -> [PackageCheck] -checkLibrary _pkg lib = +checkLibrary pkg lib = catMaybes [ check (not (null moduleDuplicates)) $ PackageBuildImpossible $ "Duplicate modules in library: " ++ commaSep (map display moduleDuplicates) + + -- check use of required-signatures/exposed-signatures sections + , checkVersion [1,21] (not (null (requiredSignatures lib))) $ + PackageDistInexcusable $ + "To use the 'required-signatures' field the package needs to specify " + ++ "at least 'cabal-version: >= 1.21'." + + , checkVersion [1,21] (not (null (exposedSignatures lib))) $ + PackageDistInexcusable $ + "To use the 'exposed-signatures' field the package needs to specify " + ++ "at least 'cabal-version: >= 1.21'." ] where - moduleDuplicates = dups (libModules lib) + checkVersion :: [Int] -> Bool -> PackageCheck -> Maybe PackageCheck + checkVersion ver cond pc + | specVersion pkg >= Version ver [] = Nothing + | otherwise = check cond pc + moduleDuplicates = dups (libModules lib ++ + map moduleReexportName (reexportedModules lib)) + checkExecutable :: PackageDescription -> Executable -> [PackageCheck] checkExecutable pkg exe = catMaybes [ @@ -473,10 +495,13 @@ checkLicense pkg = catMaybes [ - check (license pkg == AllRightsReserved) $ + check (license pkg == UnspecifiedLicense) $ PackageDistInexcusable - "The 'license' field is missing or specified as AllRightsReserved." + "The 'license' field is missing." + , check (license pkg == AllRightsReserved) $ + PackageDistSuspicious + "The 'license' is AllRightsReserved. Is that really what you want?" , case license pkg of UnknownLicense l -> Just $ PackageBuildWarning $ @@ -501,7 +526,8 @@ ++ "version then please file a ticket." _ -> Nothing - , check (license pkg `notElem` [AllRightsReserved, PublicDomain] + , check (license pkg `notElem` [ AllRightsReserved + , UnspecifiedLicense, PublicDomain] -- AllRightsReserved and PublicDomain are not strictly -- licenses so don't need license files. && null (licenseFiles pkg)) $ @@ -595,9 +621,12 @@ PackageDistInexcusable $ "'ghc-options: -fhpc' is not appropriate for a distributed package." - , check (any ("-d" `isPrefixOf`) all_ghc_options) $ + -- -dynamic is not a debug flag + , check (any (\opt -> "-d" `isPrefixOf` opt && opt /= "-dynamic") + all_ghc_options) $ PackageDistInexcusable $ - "'ghc-options: -d*' debug flags are not appropriate for a distributed package." + "'ghc-options: -d*' debug flags are not appropriate " + ++ "for a distributed package." , checkFlags ["-prof"] $ PackageBuildWarning $ @@ -607,37 +636,43 @@ , checkFlags ["-o"] $ PackageBuildWarning $ - "'ghc-options: -o' is not needed. The output files are named automatically." + "'ghc-options: -o' is not needed. " + ++ "The output files are named automatically." , checkFlags ["-hide-package"] $ PackageBuildWarning $ - "'ghc-options: -hide-package' is never needed. Cabal hides all packages." + "'ghc-options: -hide-package' is never needed. " + ++ "Cabal hides all packages." , checkFlags ["--make"] $ PackageBuildWarning $ - "'ghc-options: --make' is never needed. Cabal uses this automatically." + "'ghc-options: --make' is never needed. Cabal uses this automatically." , checkFlags ["-main-is"] $ PackageDistSuspicious $ - "'ghc-options: -main-is' is not portable." + "'ghc-options: -main-is' is not portable." , checkFlags ["-O0", "-Onot"] $ PackageDistSuspicious $ - "'ghc-options: -O0' is not needed. Use the --disable-optimization configure flag." + "'ghc-options: -O0' is not needed. " + ++ "Use the --disable-optimization configure flag." , checkFlags [ "-O", "-O1"] $ PackageDistInexcusable $ - "'ghc-options: -O' is not needed. Cabal automatically adds the '-O' flag. " - ++ "Setting it yourself interferes with the --disable-optimization flag." + "'ghc-options: -O' is not needed. " + ++ "Cabal automatically adds the '-O' flag. " + ++ "Setting it yourself interferes with the --disable-optimization flag." , checkFlags ["-O2"] $ PackageDistSuspicious $ - "'ghc-options: -O2' is rarely needed. Check that it is giving a real benefit " - ++ "and not just imposing longer compile times on your users." + "'ghc-options: -O2' is rarely needed. " + ++ "Check that it is giving a real benefit " + ++ "and not just imposing longer compile times on your users." , checkFlags ["-split-objs"] $ PackageBuildWarning $ - "'ghc-options: -split-objs' is not needed. Use the --enable-split-objs configure flag." + "'ghc-options: -split-objs' is not needed. " + ++ "Use the --enable-split-objs configure flag." , checkFlags ["-optl-Wl,-s", "-optl-s"] $ PackageDistInexcusable $ @@ -649,8 +684,14 @@ , checkFlags ["-fglasgow-exts"] $ PackageDistSuspicious $ - "Instead of 'ghc-options: -fglasgow-exts' it is preferable to use the 'extensions' field." + "Instead of 'ghc-options: -fglasgow-exts' it is preferable to use " + ++ "the 'extensions' field." + , checkProfFlags ["-auto-all"] $ + PackageDistSuspicious $ + "'ghc-prof-options: -auto-all' is fine during development, but " + ++ "not recommended in a distributed package. " + , check ("-threaded" `elem` lib_ghc_options) $ PackageDistSuspicious $ "'ghc-options: -threaded' has no effect for libraries. It should " @@ -683,49 +724,57 @@ && ("-Wall" `elem` opts || "-W" `elem` opts) has_Werror = any (\opts -> "-Werror" `elem` opts) ghc_options - ghc_options = [ strs | bi <- allBuildInfo pkg - , (GHC, strs) <- options bi ] - all_ghc_options = concat ghc_options + (ghc_options, ghc_prof_options) = + unzip . map (\bi -> (hcOptions GHC bi, hcProfOptions GHC bi)) + $ (allBuildInfo pkg) + all_ghc_options = concat ghc_options + all_ghc_prof_options = concat ghc_prof_options lib_ghc_options = maybe [] (hcOptions GHC . libBuildInfo) (library pkg) - checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck - checkFlags flags = check (any (`elem` flags) all_ghc_options) + checkFlags,checkProfFlags :: [String] -> PackageCheck -> Maybe PackageCheck + checkFlags flags = doCheckFlags flags all_ghc_options + checkProfFlags flags = doCheckFlags flags all_ghc_prof_options + doCheckFlags flags opts = check (any (`elem` flags) opts) + ghcExtension ('-':'f':name) = case name of - "allow-overlapping-instances" -> Just (EnableExtension OverlappingInstances) - "no-allow-overlapping-instances" -> Just (DisableExtension OverlappingInstances) - "th" -> Just (EnableExtension TemplateHaskell) - "no-th" -> Just (DisableExtension TemplateHaskell) - "ffi" -> Just (EnableExtension ForeignFunctionInterface) - "no-ffi" -> Just (DisableExtension ForeignFunctionInterface) - "fi" -> Just (EnableExtension ForeignFunctionInterface) - "no-fi" -> Just (DisableExtension ForeignFunctionInterface) - "monomorphism-restriction" -> Just (EnableExtension MonomorphismRestriction) - "no-monomorphism-restriction" -> Just (DisableExtension MonomorphismRestriction) - "mono-pat-binds" -> Just (EnableExtension MonoPatBinds) - "no-mono-pat-binds" -> Just (DisableExtension MonoPatBinds) - "allow-undecidable-instances" -> Just (EnableExtension UndecidableInstances) - "no-allow-undecidable-instances" -> Just (DisableExtension UndecidableInstances) - "allow-incoherent-instances" -> Just (EnableExtension IncoherentInstances) - "no-allow-incoherent-instances" -> Just (DisableExtension IncoherentInstances) - "arrows" -> Just (EnableExtension Arrows) - "no-arrows" -> Just (DisableExtension Arrows) - "generics" -> Just (EnableExtension Generics) - "no-generics" -> Just (DisableExtension Generics) - "implicit-prelude" -> Just (EnableExtension ImplicitPrelude) - "no-implicit-prelude" -> Just (DisableExtension ImplicitPrelude) - "implicit-params" -> Just (EnableExtension ImplicitParams) - "no-implicit-params" -> Just (DisableExtension ImplicitParams) - "bang-patterns" -> Just (EnableExtension BangPatterns) - "no-bang-patterns" -> Just (DisableExtension BangPatterns) - "scoped-type-variables" -> Just (EnableExtension ScopedTypeVariables) - "no-scoped-type-variables" -> Just (DisableExtension ScopedTypeVariables) - "extended-default-rules" -> Just (EnableExtension ExtendedDefaultRules) - "no-extended-default-rules" -> Just (DisableExtension ExtendedDefaultRules) + "allow-overlapping-instances" -> enable OverlappingInstances + "no-allow-overlapping-instances" -> disable OverlappingInstances + "th" -> enable TemplateHaskell + "no-th" -> disable TemplateHaskell + "ffi" -> enable ForeignFunctionInterface + "no-ffi" -> disable ForeignFunctionInterface + "fi" -> enable ForeignFunctionInterface + "no-fi" -> disable ForeignFunctionInterface + "monomorphism-restriction" -> enable MonomorphismRestriction + "no-monomorphism-restriction" -> disable MonomorphismRestriction + "mono-pat-binds" -> enable MonoPatBinds + "no-mono-pat-binds" -> disable MonoPatBinds + "allow-undecidable-instances" -> enable UndecidableInstances + "no-allow-undecidable-instances" -> disable UndecidableInstances + "allow-incoherent-instances" -> enable IncoherentInstances + "no-allow-incoherent-instances" -> disable IncoherentInstances + "arrows" -> enable Arrows + "no-arrows" -> disable Arrows + "generics" -> enable Generics + "no-generics" -> disable Generics + "implicit-prelude" -> enable ImplicitPrelude + "no-implicit-prelude" -> disable ImplicitPrelude + "implicit-params" -> enable ImplicitParams + "no-implicit-params" -> disable ImplicitParams + "bang-patterns" -> enable BangPatterns + "no-bang-patterns" -> disable BangPatterns + "scoped-type-variables" -> enable ScopedTypeVariables + "no-scoped-type-variables" -> disable ScopedTypeVariables + "extended-default-rules" -> enable ExtendedDefaultRules + "no-extended-default-rules" -> disable ExtendedDefaultRules _ -> Nothing - ghcExtension "-cpp" = Just (EnableExtension CPP) + ghcExtension "-cpp" = enable CPP ghcExtension _ = Nothing + enable e = Just (EnableExtension e) + disable e = Just (DisableExtension e) + checkCCOptions :: PackageDescription -> [PackageCheck] checkCCOptions pkg = catMaybes [ @@ -830,6 +879,7 @@ ++ [ (path, "data-dir") | path <- [dataDir pkg]] ++ concat [ [ (path, "c-sources") | path <- cSources bi ] + ++ [ (path, "js-sources") | path <- jsSources bi ] ++ [ (path, "install-includes") | path <- installIncludes bi ] ++ [ (path, "hs-source-dirs") | path <- hsSourceDirs bi ] | bi <- allBuildInfo pkg ] @@ -902,6 +952,22 @@ ++ "different modules then list the other ones in the " ++ "'other-languages' field." + -- check use of reexported-modules sections + , checkVersion [1,21] + (maybe False (not.null.reexportedModules) (library pkg)) $ + PackageDistInexcusable $ + "To use the 'reexported-module' field the package needs to specify " + ++ "at least 'cabal-version: >= 1.21'." + + -- check use of thinning and renaming + , checkVersion [1,21] (not (null depsUsingThinningRenamingSyntax)) $ + PackageDistInexcusable $ + "The package uses " + ++ "thinning and renaming in the 'build-depends' field: " + ++ commaSep (map display depsUsingThinningRenamingSyntax) + ++ ". To use this new syntax, the package needs to specify at least" + ++ "'cabal-version: >= 1.21'." + -- 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)) $ @@ -1072,10 +1138,20 @@ depsUsingWildcardSyntax = [ dep | dep@(Dependency _ vr) <- buildDepends pkg , usesWildcardSyntax vr ] - testedWithUsingWildcardSyntax = [ Dependency (PackageName (display compiler)) vr - | (compiler, vr) <- testedWith pkg - , usesWildcardSyntax vr ] + -- XXX: If the user writes build-depends: foo with (), this is + -- indistinguishable from build-depends: foo, so there won't be an + -- error even though there should be + depsUsingThinningRenamingSyntax = + [ name + | bi <- allBuildInfo pkg + , (name, rns) <- Map.toList (targetBuildRenaming bi) + , rns /= ModuleRenaming True [] ] + testedWithUsingWildcardSyntax = + [ Dependency (PackageName (display compiler)) vr + | (compiler, vr) <- testedWith pkg + , usesWildcardSyntax vr ] + usesWildcardSyntax :: VersionRange -> Bool usesWildcardSyntax = foldVersionRange' @@ -1094,7 +1170,8 @@ intersectVersionRanges unionVersionRanges id compatLicenses = [ GPL Nothing, LGPL Nothing, AGPL Nothing, BSD3, BSD4 - , PublicDomain, AllRightsReserved, OtherLicense ] + , PublicDomain, AllRightsReserved + , UnspecifiedLicense, OtherLicense ] mentionedExtensions = [ ext | bi <- allBuildInfo pkg , ext <- allExtensions bi ] @@ -1154,8 +1231,10 @@ (\v -> (Disp.text ">=" <> disp v , 0)) (\v -> (Disp.text "<=" <> disp v , 0)) (\v _ -> (Disp.text "==" <> dispWild v , 0)) - (\(r1, p1) (r2, p2) -> (punct 2 p1 r1 <+> Disp.text "||" <+> punct 2 p2 r2 , 2)) - (\(r1, p1) (r2, p2) -> (punct 1 p1 r1 <+> Disp.text "&&" <+> punct 1 p2 r2 , 1)) + (\(r1, p1) (r2, p2) -> + (punct 2 p1 r1 <+> Disp.text "||" <+> punct 2 p2 r2 , 2)) + (\(r1, p1) (r2, p2) -> + (punct 1 p1 r1 <+> Disp.text "&&" <+> punct 1 p2 r2 , 1)) (\(r, _ ) -> (Disp.parens r, 0)) -- parens where @@ -1208,7 +1287,8 @@ -- using no package index and the current platform. finalised = finalizePackageDescription [] (const True) buildPlatform - (CompilerId buildCompilerFlavor (Version [] [])) + (unknownCompilerInfo + (CompilerId buildCompilerFlavor (Version [] [])) NoAbiTag) [] pkg baseDependency = case finalised of Right (pkg', _) | not (null baseDeps) -> @@ -1341,7 +1421,8 @@ exists <- doesFileExist ops "configure" return $ check (not exists) $ PackageBuildWarning $ - "The 'build-type' is 'Configure' but there is no 'configure' script." + "The 'build-type' is 'Configure' but there is no 'configure' script. " + ++ "You probably need to run 'autoreconf -i' to generate it." checkConfigureExists _ _ = return Nothing checkLocalPathsExist :: Monad m => CheckPackageContentOps m diff --git a/Distribution/PackageDescription/Configuration.hs b/Distribution/PackageDescription/Configuration.hs --- a/Distribution/PackageDescription/Configuration.hs +++ b/Distribution/PackageDescription/Configuration.hs @@ -46,6 +46,8 @@ ( Platform(..), OS, Arch ) import Distribution.Simple.Utils ( currentDir, lowercase ) +import Distribution.Simple.Compiler + ( CompilerInfo(..) ) import Distribution.Text ( Text(parse) ) @@ -97,16 +99,23 @@ -- | Simplify a configuration condition using the OS and arch names. Returns -- the names of all the flags occurring in the condition. -simplifyWithSysParams :: OS -> Arch -> CompilerId -> Condition ConfVar +simplifyWithSysParams :: OS -> Arch -> CompilerInfo -> Condition ConfVar -> (Condition FlagName, [FlagName]) -simplifyWithSysParams os arch (CompilerId comp compVer) cond = (cond', flags) +simplifyWithSysParams os arch cinfo cond = (cond', flags) where (cond', flags) = simplifyCondition cond interp interp (OS os') = Right $ os' == os interp (Arch arch') = Right $ arch' == arch - interp (Impl comp' vr) = Right $ comp' == comp - && compVer `withinRange` vr - interp (Flag f) = Left f + interp (Impl comp vr) + | matchImpl (compilerInfoId cinfo) = Right True + | otherwise = case compilerInfoCompat cinfo of + -- fixme: treat Nothing as unknown, rather than empty list once we + -- support partial resolution of system parameters + Nothing -> Right False + Just compat -> Right (any matchImpl compat) + where + matchImpl (CompilerId c v) = comp == c && v `withinRange` vr + interp (Flag f) = Left f -- TODO: Add instances and check -- @@ -208,7 +217,7 @@ -- ^ Domain for each flag name, will be tested in order. -> OS -- ^ OS as returned by Distribution.System.buildOS -> Arch -- ^ Arch as returned by Distribution.System.buildArch - -> CompilerId -- ^ Compiler flavour + version + -> CompilerInfo -- ^ Compiler information -> [Dependency] -- ^ Additional constraints -> [CondTree ConfVar [Dependency] PDTagged] -> ([Dependency] -> DepTestRslt [Dependency]) -- ^ Dependency test function. @@ -463,7 +472,7 @@ -- available packages? If this is unknown then use -- True. -> Platform -- ^ The 'Arch' and 'OS' - -> CompilerId -- ^ Compiler + Version + -> CompilerInfo -- ^ Compiler information -> [Dependency] -- ^ Additional constraints -> GenericPackageDescription -> Either [Dependency] diff --git a/Distribution/PackageDescription/Parse.hs b/Distribution/PackageDescription/Parse.hs --- a/Distribution/PackageDescription/Parse.hs +++ b/Distribution/PackageDescription/Parse.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.PackageDescription.Parse @@ -48,11 +49,15 @@ import Control.Arrow (first) import System.Directory (doesFileExist) import qualified Data.ByteString.Lazy.Char8 as BS.Char8 +import Data.Typeable +import Data.Data +import qualified Data.Map as Map import Distribution.Text ( Text(disp, parse), display, simpleParse ) import Distribution.Compat.ReadP ((+++), option) +import qualified Distribution.Compat.ReadP as Parse import Text.PrettyPrint import Distribution.ParseUtils hiding (parseFields) @@ -118,9 +123,6 @@ , simpleField "maintainer" showFreeText parseFreeText maintainer (\val pkg -> pkg{maintainer=val}) - , commaListFieldWithSep vcat "build-depends" - disp parse - buildDepends (\xs pkg -> pkg{buildDepends=xs}) , simpleField "stability" showFreeText parseFreeText stability (\val pkg -> pkg{stability=val}) @@ -181,6 +183,15 @@ [ listFieldWithSep vcat "exposed-modules" disp parseModuleNameQ exposedModules (\mods lib -> lib{exposedModules=mods}) + , commaListFieldWithSep vcat "reexported-modules" disp parse + reexportedModules (\mods lib -> lib{reexportedModules=mods}) + + , listFieldWithSep vcat "required-signatures" disp parseModuleNameQ + requiredSignatures (\mods lib -> lib{requiredSignatures=mods}) + + , listFieldWithSep vcat "exposed-signatures" disp parseModuleNameQ + exposedSignatures (\mods lib -> lib{exposedSignatures=mods}) + , boolField "exposed" libExposed (\val lib -> lib{libExposed=val}) ] ++ map biToLib binfoFieldDescrs @@ -385,6 +396,10 @@ , commaListField "build-tools" disp parseBuildTool buildTools (\xs binfo -> binfo{buildTools=xs}) + , commaListFieldWithSep vcat "build-depends" + disp parse + buildDependsWithRenaming + setBuildDependsWithRenaming , spaceListField "cpp-options" showToken parseTokenQ' cppOptions (\val binfo -> binfo{cppOptions=val}) @@ -403,7 +418,9 @@ , listFieldWithSep vcat "c-sources" showFilePath parseFilePathQ cSources (\paths binfo -> binfo{cSources=paths}) - + , listFieldWithSep vcat "js-sources" + showFilePath parseFilePathQ + jsSources (\paths binfo -> binfo{jsSources=paths}) , simpleField "default-language" (maybe empty disp) (option Nothing (fmap Just parseLanguageQ)) defaultLanguage (\lang binfo -> binfo{defaultLanguage=lang}) @@ -423,6 +440,9 @@ , listFieldWithSep vcat "extra-libraries" showToken parseTokenQ extraLibs (\xs binfo -> binfo{extraLibs=xs}) + , listFieldWithSep vcat "extra-ghci-libraries" + showToken parseTokenQ + extraGHCiLibs (\xs binfo -> binfo{extraGHCiLibs=xs}) , listField "extra-lib-dirs" showFilePath parseFilePathQ extraLibDirs (\xs binfo -> binfo{extraLibDirs=xs}) @@ -441,20 +461,27 @@ , listFieldWithSep vcat "other-modules" disp parseModuleNameQ otherModules (\val binfo -> binfo{otherModules=val}) - , listField "ghc-prof-options" - text parseTokenQ - ghcProfOptions (\val binfo -> binfo{ghcProfOptions=val}) - , listField "ghc-shared-options" - text parseTokenQ - ghcSharedOptions (\val binfo -> binfo{ghcSharedOptions=val}) + , optsField "ghc-prof-options" GHC + profOptions (\val binfo -> binfo{profOptions=val}) + , optsField "ghcjs-prof-options" GHCJS + profOptions (\val binfo -> binfo{profOptions=val}) + , optsField "ghc-shared-options" GHC + sharedOptions (\val binfo -> binfo{sharedOptions=val}) + , optsField "ghcjs-shared-options" GHCJS + sharedOptions (\val binfo -> binfo{sharedOptions=val}) , optsField "ghc-options" GHC options (\path binfo -> binfo{options=path}) - , optsField "hugs-options" Hugs - options (\path binfo -> binfo{options=path}) - , optsField "nhc98-options" NHC + , optsField "ghcjs-options" GHCJS options (\path binfo -> binfo{options=path}) , optsField "jhc-options" JHC options (\path binfo -> binfo{options=path}) + + -- NOTE: Hugs and NHC are not supported anymore, but these fields are kept + -- around for backwards compatibility. + , optsField "hugs-options" Hugs + options (const id) + , optsField "nhc98-options" NHC + options (const id) ] storeXFieldsBI :: UnrecFieldParser BuildInfo @@ -565,7 +592,7 @@ -- they add and define an accessor that specifies what the dependencies -- are. This way we would completely reuse the parsing knowledge from the -- field descriptor. -parseConstraint :: Field -> ParseResult [Dependency] +parseConstraint :: Field -> ParseResult [DependencyWithRenaming] parseConstraint (F l n v) | n == "build-depends" = runP l n (parseCommaList parse) v parseConstraint f = userBug $ "Constraint was expected (got: " ++ show f ++ ")" @@ -1002,15 +1029,17 @@ condFlds = [ f | f@IfBlock{} <- allflds ] sections = [ s | s@Section{} <- allflds ] - let (depFlds, dataFlds) = partition isConstraint simplFlds + -- Put these through the normal parsing pass too, so that we + -- collect the ModRenamings + let depFlds = filter isConstraint simplFlds mapM_ (\(Section l n _ _) -> lift . warning $ "Unexpected section '" ++ n ++ "' on line " ++ show l) sections - a <- parser dataFlds - deps <- liftM concat . mapM (lift . parseConstraint) $ depFlds + a <- parser simplFlds + deps <- liftM concat . mapM (lift . fmap (map dependency) . parseConstraint) $ depFlds ifs <- mapM processIfs condFlds @@ -1214,3 +1243,32 @@ --test_findIndentTabs = findIndentTabs $ unlines $ -- [ "foo", " bar", " \t baz", "\t biz\t", "\t\t \t mib" ] + +-- | Dependencies plus module renamings. This is what users specify; however, +-- renaming information is not used for dependency resolution. +data DependencyWithRenaming = DependencyWithRenaming Dependency ModuleRenaming + deriving (Read, Show, Eq, Typeable, Data) + +dependency :: DependencyWithRenaming -> Dependency +dependency (DependencyWithRenaming dep _) = dep + +instance Text DependencyWithRenaming where + disp (DependencyWithRenaming d rns) = disp d <+> disp rns + parse = do d <- parse + Parse.skipSpaces + rns <- parse + Parse.skipSpaces + return (DependencyWithRenaming d rns) + +buildDependsWithRenaming :: BuildInfo -> [DependencyWithRenaming] +buildDependsWithRenaming pkg = + map (\dep@(Dependency n _) -> + DependencyWithRenaming dep + (Map.findWithDefault defaultRenaming n (targetBuildRenaming pkg))) + (targetBuildDepends pkg) + +setBuildDependsWithRenaming :: [DependencyWithRenaming] -> BuildInfo -> BuildInfo +setBuildDependsWithRenaming deps pkg = pkg { + targetBuildDepends = map dependency deps, + targetBuildRenaming = Map.fromList (map (\(DependencyWithRenaming (Dependency n _) rns) -> (n, rns)) deps) + } diff --git a/Distribution/PackageDescription/PrettyPrint.hs b/Distribution/PackageDescription/PrettyPrint.hs --- a/Distribution/PackageDescription/PrettyPrint.hs +++ b/Distribution/PackageDescription/PrettyPrint.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- +-- | -- Module : Distribution.PackageDescription.PrettyPrint -- Copyright : Jürgen Nicklisch-Franken 2010 -- License : BSD3 @@ -8,7 +8,7 @@ -- Stability : provisional -- Portability : portable -- --- | Pretty printing for cabal files +-- Pretty printing for cabal files -- ----------------------------------------------------------------------------- @@ -32,7 +32,7 @@ import Distribution.Simple.Utils (writeUTF8File) import Distribution.ParseUtils (showFreeText, FieldDescr(..), indentWith, ppField, ppFields) import Distribution.PackageDescription.Parse (pkgDescrFieldDescrs,binfoFieldDescrs,libFieldDescrs, - sourceRepoFieldDescrs) + sourceRepoFieldDescrs,flagFieldDescrs) import Distribution.Package (Dependency(..)) import Distribution.Text (Text(..)) import Data.Maybe (isJust, fromJust, isNothing) @@ -74,6 +74,23 @@ where sourceRepoFieldDescrs' = [fd | fd <- sourceRepoFieldDescrs, fieldName fd /= "kind"] +-- TODO: this is a temporary hack. Ideally, fields containing default values +-- would be filtered out when the @FieldDescr a@ list is generated. +ppFieldsFiltered :: [(String, String)] -> [FieldDescr a] -> a -> Doc +ppFieldsFiltered removable fields x = ppFields (filter nondefault fields) x + where + nondefault (FieldDescr name getter _) = + maybe True (render (getter x) /=) (lookup name removable) + +binfoDefaults :: [(String, String)] +binfoDefaults = [("buildable", "True")] + +libDefaults :: [(String, String)] +libDefaults = ("exposed", "True") : binfoDefaults + +flagDefaults :: [(String, String)] +flagDefaults = [("default", "True"), ("manual", "False")] + ppDiffFields :: [FieldDescr a] -> a -> a -> Doc ppDiffFields fields x y = vcat [ ppField name (getter x) @@ -91,20 +108,17 @@ ppGenPackageFlags flds = vcat [ppFlag f | f <- flds] ppFlag :: Flag -> Doc -ppFlag (MkFlag name desc dflt manual) = - emptyLine $ text "flag" <+> ppFlagName name $+$ - (nest indentWith ((if null desc - then empty - else text "description: " <+> showFreeText desc) $+$ - (if dflt then empty else text "default: False") $+$ - (if manual then text "manual: True" else empty))) +ppFlag flag@(MkFlag name _ _ _) = + emptyLine $ text "flag" <+> ppFlagName name $+$ nest indentWith fields + where + fields = ppFieldsFiltered flagDefaults flagFieldDescrs flag ppLibrary :: (Maybe (CondTree ConfVar [Dependency] Library)) -> Doc ppLibrary Nothing = empty ppLibrary (Just condTree) = emptyLine $ text "library" $+$ nest indentWith (ppCondTree condTree Nothing ppLib) where - ppLib lib Nothing = ppFields libFieldDescrs lib + ppLib lib Nothing = ppFieldsFiltered libDefaults libFieldDescrs lib $$ ppCustomFields (customFieldsBI (libBuildInfo lib)) ppLib lib (Just plib) = ppDiffFields libFieldDescrs lib plib $$ ppCustomFields (customFieldsBI (libBuildInfo lib)) @@ -116,7 +130,7 @@ where ppExe (Executable _ modulePath' buildInfo') Nothing = (if modulePath' == "" then empty else text "main-is:" <+> text modulePath') - $+$ ppFields binfoFieldDescrs buildInfo' + $+$ ppFieldsFiltered binfoDefaults binfoFieldDescrs buildInfo' $+$ ppCustomFields (customFieldsBI buildInfo') ppExe (Executable _ modulePath' buildInfo') (Just (Executable _ modulePath2 buildInfo2)) = @@ -138,7 +152,7 @@ (testSuiteMainIs testsuite) $+$ maybe empty (\m -> text "test-module:" <+> disp m) (testSuiteModule testsuite) - $+$ ppFields binfoFieldDescrs (testBuildInfo testsuite) + $+$ ppFieldsFiltered binfoDefaults binfoFieldDescrs (testBuildInfo testsuite) $+$ ppCustomFields (customFieldsBI (testBuildInfo testsuite)) where maybeTestType | testInterface testsuite == mempty = Nothing @@ -168,7 +182,7 @@ maybeBenchmarkType $+$ maybe empty (\f -> text "main-is:" <+> text f) (benchmarkMainIs benchmark) - $+$ ppFields binfoFieldDescrs (benchmarkBuildInfo benchmark) + $+$ ppFieldsFiltered binfoDefaults binfoFieldDescrs (benchmarkBuildInfo benchmark) $+$ ppCustomFields (customFieldsBI (benchmarkBuildInfo benchmark)) where maybeBenchmarkType | benchmarkInterface benchmark == mempty = Nothing @@ -209,6 +223,7 @@ then ppCondTree ct Nothing ppIt else res where + -- TODO: this ends up printing trailing spaces when combined with nest. ppIf (c,thenTree,mElseTree) = ((emptyLine $ text "if" <+> ppCondition c) $$ nest indentWith (ppCondTree thenTree @@ -225,7 +240,7 @@ text "build-depends:" $+$ nest indentWith (vcat (punctuate comma (map disp deps))) emptyLine :: Doc -> Doc -emptyLine d = text " " $+$ d +emptyLine d = text "" $+$ d diff --git a/Distribution/ParseUtils.hs b/Distribution/ParseUtils.hs --- a/Distribution/ParseUtils.hs +++ b/Distribution/ParseUtils.hs @@ -50,7 +50,8 @@ import Distribution.Text ( Text(..) ) import Distribution.Simple.Utils - ( comparing, intercalate, lowercase, normaliseLineEndings ) + ( comparing, dropWhileEndLE, intercalate, lowercase + , normaliseLineEndings ) import Language.Haskell.Extension ( Language, Extension ) @@ -198,7 +199,7 @@ where set' xs b = set (get b ++ xs) b showF' = separator . punctuate comma . map showF - + commaListField :: String -> (a -> Doc) -> ReadP [a] a -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b commaListField = commaListFieldWithSep fsep @@ -267,7 +268,7 @@ vcat [ ppField name (getter x) | FieldDescr name getter _ <- fields ] ppField :: String -> Doc -> Doc -ppField name fielddoc +ppField name fielddoc | isEmpty fielddoc = empty | name `elem` nestedFields = text name <> colon $+$ nest indentWith fielddoc | otherwise = text name <> colon <+> fielddoc @@ -280,6 +281,7 @@ , "extra-tmp-files" , "exposed-modules" , "c-sources" + , "js-sources" , "extra-libraries" , "includes" , "install-includes" @@ -477,7 +479,7 @@ trimLeading, trimTrailing :: String -> String trimLeading = dropWhile isSpace -trimTrailing = reverse . dropWhile isSpace . reverse +trimTrailing = dropWhileEndLE isSpace type SyntaxTree = Tree (LineNo, HasTabs, String) @@ -656,7 +658,7 @@ parseOptVersion = parseQuoted ver <++ ver where ver :: ReadP r Version ver = parse <++ return noVersion - noVersion = Version{ versionBranch=[], versionTags=[] } + noVersion = Version [] [] parseTestedWithQ :: ReadP r (CompilerFlavor,VersionRange) parseTestedWithQ = parseQuoted tw <++ tw diff --git a/Distribution/Simple.hs b/Distribution/Simple.hs --- a/Distribution/Simple.hs +++ b/Distribution/Simple.hs @@ -143,7 +143,7 @@ defaultMainHelper :: UserHooks -> Args -> IO () defaultMainHelper hooks args = topHandler $ - case commandsRun globalCommand commands args of + case commandsRun (globalCommand commands) commands args of CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs @@ -347,12 +347,9 @@ -- default action is a no-op and if the package uses the old test interface -- the new handler will find no tests. runTests hooks args False pkg_descr localBuildInfo - --FIXME: this is a hack, passing the args inside the flags - -- it's because the args to not get passed to the main test hook - let flags' = flags { testList = Flag args } - hookedAction preTest testHook postTest + hookedActionWithArgs preTest testHook postTest (getBuildConfig hooks verbosity distPref) - hooks flags' args + hooks flags args benchAction :: UserHooks -> BenchmarkFlags -> Args -> IO () benchAction hooks flags args = do @@ -510,7 +507,7 @@ buildHook = defaultBuildHook, replHook = defaultReplHook, copyHook = \desc lbi _ f -> install desc lbi f, -- has correct 'copy' behavior with params - testHook = defaultTestHook, + testHook = defaultTestHook, benchHook = defaultBenchHook, instHook = defaultInstallHook, sDistHook = \p l h f -> sdist p l f srcPref (allSuffixHandlers h), @@ -653,10 +650,10 @@ info verbosity $ "Reading parameters from " ++ infoFile readHookedBuildInfo verbosity infoFile -defaultTestHook :: PackageDescription -> LocalBuildInfo +defaultTestHook :: Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> TestFlags -> IO () -defaultTestHook pkg_descr localbuildinfo _ flags = - test pkg_descr localbuildinfo flags +defaultTestHook args pkg_descr localbuildinfo _ flags = + test args pkg_descr localbuildinfo flags defaultBenchHook :: Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> BenchmarkFlags -> IO () diff --git a/Distribution/Simple/Bench.hs b/Distribution/Simple/Bench.hs --- a/Distribution/Simple/Bench.hs +++ b/Distribution/Simple/Bench.hs @@ -19,7 +19,7 @@ ( PackageDescription(..), BuildInfo(buildable) , Benchmark(..), BenchmarkInterface(..), benchmarkType, hasBenchmarks ) import Distribution.Simple.BuildPaths ( exeExtension ) -import Distribution.Simple.Compiler ( Compiler(..) ) +import Distribution.Simple.Compiler ( compilerInfo ) import Distribution.Simple.InstallDirs ( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..) , substPathTemplate , toPathTemplate, PathTemplate ) @@ -112,8 +112,8 @@ ExitFailure _ -> "ERROR") --- TODO: This is abusing the notion of a 'PathTemplate'. The result --- isn't neccesarily a path. +-- TODO: This is abusing the notion of a 'PathTemplate'. The result isn't +-- necessarily a path. benchOption :: PD.PackageDescription -> LBI.LocalBuildInfo -> PD.Benchmark @@ -123,6 +123,6 @@ fromPathTemplate $ substPathTemplate env template where env = initialPathTemplateEnv - (PD.package pkg_descr) (compilerId $ LBI.compiler lbi) - (LBI.hostPlatform lbi) ++ + (PD.package pkg_descr) (LBI.pkgKey lbi) + (compilerInfo $ LBI.compiler lbi) (LBI.hostPlatform lbi) ++ [(BenchmarkNameVar, toPathTemplate $ PD.benchmarkName bm)] diff --git a/Distribution/Simple/Build.hs b/Distribution/Simple/Build.hs --- a/Distribution/Simple/Build.hs +++ b/Distribution/Simple/Build.hs @@ -23,12 +23,11 @@ writeAutogenFiles, ) where -import qualified Distribution.Simple.GHC as GHC -import qualified Distribution.Simple.JHC as JHC -import qualified Distribution.Simple.LHC as LHC -import qualified Distribution.Simple.NHC as NHC -import qualified Distribution.Simple.Hugs as Hugs -import qualified Distribution.Simple.UHC as UHC +import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.GHCJS as GHCJS +import qualified Distribution.Simple.JHC as JHC +import qualified Distribution.Simple.LHC as LHC +import qualified Distribution.Simple.UHC as UHC import qualified Distribution.Simple.HaskellSuite as HaskellSuite import qualified Distribution.Simple.Build.Macros as Build.Macros @@ -36,14 +35,14 @@ import Distribution.Package ( Package(..), PackageName(..), PackageIdentifier(..) - , Dependency(..), thisPackageVersion ) + , Dependency(..), thisPackageVersion, mkPackageKey, packageName ) import Distribution.Simple.Compiler ( Compiler, CompilerFlavor(..), compilerFlavor - , PackageDB(..), PackageDBStack ) + , PackageDB(..), PackageDBStack, packageKeySupported ) import Distribution.PackageDescription ( PackageDescription(..), BuildInfo(..), Library(..), Executable(..) , TestSuite(..), TestSuiteInterface(..), Benchmark(..) - , BenchmarkInterface(..) ) + , BenchmarkInterface(..), defaultRenaming ) import qualified Distribution.InstalledPackageInfo as IPI import qualified Distribution.ModuleName as ModuleName import Distribution.ModuleName (ModuleName) @@ -55,7 +54,7 @@ import Distribution.Simple.PreProcess ( preprocessComponent, PPSuffixHandler ) import Distribution.Simple.LocalBuildInfo - ( LocalBuildInfo(compiler, buildDir, withPackageDB, withPrograms) + ( LocalBuildInfo(compiler, buildDir, withPackageDB, withPrograms, pkgKey) , Component(..), componentName, getComponent, componentBuildInfo , ComponentLocalBuildInfo(..), pkgEnabledComponents , withComponentsInBuildOrder, componentsInBuildOrder @@ -64,6 +63,7 @@ , inplacePackageId, LibraryName(..) ) import Distribution.Simple.Program.Types import Distribution.Simple.Program.Db +import qualified Distribution.Simple.Program.HcPkg as HcPkg import Distribution.Simple.BuildPaths ( autogenModulesDir, autogenModuleName, cppHeaderName, exeExtension ) import Distribution.Simple.Register @@ -78,6 +78,7 @@ import Distribution.Text ( display ) +import qualified Data.Map as Map import Data.Maybe ( maybeToList ) import Data.Either @@ -89,7 +90,7 @@ import System.FilePath ( (), (<.>) ) import System.Directory - ( getCurrentDirectory ) + ( getCurrentDirectory, removeDirectoryRecursive, doesDirectoryExist ) -- ----------------------------------------------------------------------------- -- |Build the libraries and executables in this package. @@ -114,7 +115,7 @@ -- Only bother with this message if we're building the whole package setupMessage verbosity "Building" (packageId pkg_descr) - internalPackageDB <- createInternalPackageDB distPref + internalPackageDB <- createInternalPackageDB verbosity lbi distPref withComponentsInBuildOrder pkg_descr lbi componentsToBuild $ \comp clbi -> let bi = componentBuildInfo comp @@ -151,7 +152,8 @@ initialBuildSteps distPref pkg_descr lbi verbosity - internalPackageDB <- createInternalPackageDB distPref + internalPackageDB <- createInternalPackageDB verbosity lbi distPref + let lbiForComponent comp lbi' = lbi' { withPackageDB = withPackageDB lbi ++ [internalPackageDB], @@ -178,8 +180,9 @@ startInterpreter :: Verbosity -> ProgramDb -> Compiler -> PackageDBStack -> IO () startInterpreter verbosity programDb comp packageDBs = case compilerFlavor comp of - GHC -> GHC.startInterpreter verbosity programDb comp packageDBs - _ -> die "A REPL is not supported with this compiler." + GHC -> GHC.startInterpreter verbosity programDb comp packageDBs + GHCJS -> GHCJS.startInterpreter verbosity programDb comp packageDBs + _ -> die "A REPL is not supported with this compiler." buildComponent :: Verbosity -> Flag (Maybe Int) @@ -199,12 +202,11 @@ -- Register the library in-place, so exes can depend -- on internally defined libraries. pwd <- getCurrentDirectory - let installedPkgInfo = - (inplaceInstalledPackageInfo pwd distPref pkg_descr lib lbi clbi) { - -- The in place registration uses the "-inplace" suffix, - -- not an ABI hash. - IPI.installedPackageId = inplacePackageId (packageId installedPkgInfo) - } + let -- The in place registration uses the "-inplace" suffix, not an ABI hash + ipkgid = inplacePackageId (packageId installedPkgInfo) + installedPkgInfo = inplaceInstalledPackageInfo pwd distPref pkg_descr + ipkgid lib lbi clbi + registerPackage verbosity installedPkgInfo pkg_descr lbi True -- True meaning in place (withPackageDB lbi) @@ -226,7 +228,7 @@ buildExe verbosity numJobs pkg_descr lbi exe clbi -buildComponent verbosity numJobs pkg_descr lbi suffixes +buildComponent verbosity numJobs pkg_descr lbi0 suffixes comp@(CTest test@TestSuite { testInterface = TestSuiteLibV09{} }) clbi -- This ComponentLocalBuildInfo corresponds to a detailed @@ -236,8 +238,8 @@ -- built. distPref = do pwd <- getCurrentDirectory - let (pkg, lib, libClbi, ipi, exe, exeClbi) = - testSuiteLibV09AsLibAndExe pkg_descr lbi test clbi distPref pwd + let (pkg, lib, libClbi, lbi, ipi, exe, exeClbi) = + testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd preprocessComponent pkg_descr comp lbi False verbosity suffixes info verbosity $ "Building test suite " ++ testName test ++ "..." buildLib verbosity numJobs pkg lbi lib libClbi @@ -293,13 +295,13 @@ replExe verbosity pkg_descr lbi exe clbi -replComponent verbosity pkg_descr lbi suffixes +replComponent verbosity pkg_descr lbi0 suffixes comp@(CTest test@TestSuite { testInterface = TestSuiteLibV09{} }) clbi distPref = do pwd <- getCurrentDirectory - let (pkg, lib, libClbi, _, _, _) = - testSuiteLibV09AsLibAndExe pkg_descr lbi test clbi distPref pwd + let (pkg, lib, libClbi, lbi, _, _, _) = + testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd preprocessComponent pkg_descr comp lbi False verbosity suffixes replLib verbosity pkg lbi lib libClbi @@ -339,29 +341,35 @@ -- | Translate a lib-style 'TestSuite' component into a lib + exe for building testSuiteLibV09AsLibAndExe :: PackageDescription - -> LocalBuildInfo -> TestSuite -> ComponentLocalBuildInfo + -> LocalBuildInfo -> FilePath -> FilePath -> (PackageDescription, Library, ComponentLocalBuildInfo, + LocalBuildInfo, IPI.InstalledPackageInfo_ ModuleName, Executable, ComponentLocalBuildInfo) -testSuiteLibV09AsLibAndExe pkg_descr lbi +testSuiteLibV09AsLibAndExe pkg_descr test@TestSuite { testInterface = TestSuiteLibV09 _ m } - clbi distPref pwd = - (pkg, lib, libClbi, ipi, exe, exeClbi) + clbi lbi distPref pwd = + (pkg, lib, libClbi, lbi', ipi, exe, exeClbi) where bi = testBuildInfo test lib = Library { exposedModules = [ m ], + reexportedModules = [], + requiredSignatures = [], + exposedSignatures = [], libExposed = True, libBuildInfo = bi } libClbi = LibComponentLocalBuildInfo { componentPackageDeps = componentPackageDeps clbi + , componentPackageRenaming = componentPackageRenaming clbi , componentLibraries = [LibraryName (testName test)] + , componentExposedModules = [IPI.ExposedModule m Nothing Nothing] } pkg = pkg_descr { package = (package pkg_descr) { @@ -372,9 +380,16 @@ , testSuites = [] , library = Just lib } - ipi = (inplaceInstalledPackageInfo pwd distPref pkg lib lbi libClbi) { - IPI.installedPackageId = inplacePackageId $ packageId ipi - } + -- Hack to make the library compile with the right package key. + -- Probably the "right" way to do this is move this information to + -- the ComponentLocalBuildInfo, but it seems odd that a single package + -- can define multiple actual packages. + lbi' = lbi { + pkgKey = mkPackageKey (packageKeySupported (compiler lbi)) + (package pkg) [] [] + } + ipkgid = inplacePackageId (packageId pkg) + ipi = inplaceInstalledPackageInfo pwd distPref pkg ipkgid lib lbi libClbi testDir = buildDir lbi stubName test stubName test ++ "-tmp" testLibDep = thisPackageVersion $ package pkg @@ -384,7 +399,10 @@ buildInfo = (testBuildInfo test) { hsSourceDirs = [ testDir ], targetBuildDepends = testLibDep - : (targetBuildDepends $ testBuildInfo test) + : (targetBuildDepends $ testBuildInfo test), + targetBuildRenaming = + Map.insert (packageName pkg) defaultRenaming + (targetBuildRenaming $ testBuildInfo test) } } -- | The stub executable needs a new 'ComponentLocalBuildInfo' @@ -394,9 +412,12 @@ (IPI.installedPackageId ipi, packageId ipi) : (filter (\(_, x) -> let PackageName name = pkgName x in name == "Cabal" || name == "base") - (componentPackageDeps clbi)) + (componentPackageDeps clbi)), + componentPackageRenaming = + Map.insert (packageName ipi) defaultRenaming + (componentPackageRenaming clbi) } -testSuiteLibV09AsLibAndExe _ _ TestSuite{} _ _ _ = error "testSuiteLibV09AsLibAndExe: wrong kind" +testSuiteLibV09AsLibAndExe _ TestSuite{} _ _ _ _ = error "testSuiteLibV09AsLibAndExe: wrong kind" -- | Translate a exe-style 'Benchmark' component into an exe for building @@ -412,18 +433,29 @@ buildInfo = benchmarkBuildInfo bm } exeClbi = ExeComponentLocalBuildInfo { - componentPackageDeps = componentPackageDeps clbi + componentPackageDeps = componentPackageDeps clbi, + componentPackageRenaming = componentPackageRenaming clbi } benchmarkExeV10asExe Benchmark{} _ = error "benchmarkExeV10asExe: wrong kind" -- | Initialize a new package db file for libraries defined -- internally to the package. -createInternalPackageDB :: FilePath -> IO PackageDB -createInternalPackageDB distPref = do - let dbFile = distPref "package.conf.inplace" - packageDB = SpecificPackageDB dbFile - writeFile dbFile "[]" - return packageDB +createInternalPackageDB :: Verbosity -> LocalBuildInfo -> FilePath + -> IO PackageDB +createInternalPackageDB verbosity lbi distPref = do + case compilerFlavor (compiler lbi) of + GHC -> createWith $ GHC.hcPkgInfo (withPrograms lbi) + GHCJS -> createWith $ GHCJS.hcPkgInfo (withPrograms lbi) + LHC -> createWith $ LHC.hcPkgInfo (withPrograms lbi) + _ -> return packageDB + where + dbDir = distPref "package.conf.inplace" + packageDB = SpecificPackageDB dbDir + createWith hpi = do + exists <- doesDirectoryExist dbDir + when exists $ removeDirectoryRecursive dbDir + HcPkg.init hpi verbosity dbDir + return packageDB addInternalBuildTools :: PackageDescription -> LocalBuildInfo -> BuildInfo -> ProgramDb -> ProgramDb @@ -448,12 +480,11 @@ -> Library -> ComponentLocalBuildInfo -> IO () buildLib verbosity numJobs pkg_descr lbi lib clbi = case compilerFlavor (compiler lbi) of - GHC -> GHC.buildLib verbosity numJobs pkg_descr lbi lib clbi - JHC -> JHC.buildLib verbosity pkg_descr lbi lib clbi - LHC -> LHC.buildLib verbosity pkg_descr lbi lib clbi - Hugs -> Hugs.buildLib verbosity pkg_descr lbi lib clbi - NHC -> NHC.buildLib verbosity pkg_descr lbi lib clbi - UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi + GHC -> GHC.buildLib verbosity numJobs pkg_descr lbi lib clbi + GHCJS -> GHCJS.buildLib verbosity numJobs pkg_descr lbi lib clbi + JHC -> JHC.buildLib verbosity pkg_descr lbi lib clbi + LHC -> LHC.buildLib verbosity pkg_descr lbi lib clbi + UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi HaskellSuite {} -> HaskellSuite.buildLib verbosity pkg_descr lbi lib clbi _ -> die "Building is not supported with this compiler." @@ -462,14 +493,12 @@ -> Executable -> ComponentLocalBuildInfo -> IO () buildExe verbosity numJobs pkg_descr lbi exe clbi = case compilerFlavor (compiler lbi) of - GHC -> GHC.buildExe verbosity numJobs pkg_descr lbi exe clbi - JHC -> JHC.buildExe verbosity pkg_descr lbi exe clbi - LHC -> LHC.buildExe verbosity pkg_descr lbi exe clbi - Hugs -> Hugs.buildExe verbosity pkg_descr lbi exe clbi - NHC -> NHC.buildExe verbosity pkg_descr lbi exe clbi - UHC -> UHC.buildExe verbosity pkg_descr lbi exe clbi - _ -> die "Building is not supported with this compiler." - + GHC -> GHC.buildExe verbosity numJobs pkg_descr lbi exe clbi + GHCJS -> GHCJS.buildExe verbosity numJobs pkg_descr lbi exe clbi + JHC -> JHC.buildExe verbosity pkg_descr lbi exe clbi + LHC -> LHC.buildExe verbosity pkg_descr lbi exe clbi + UHC -> UHC.buildExe verbosity pkg_descr lbi exe clbi + _ -> die "Building is not supported with this compiler." replLib :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () @@ -477,15 +506,17 @@ case compilerFlavor (compiler lbi) of -- 'cabal repl' doesn't need to support 'ghc --make -j', so we just pass -- NoFlag as the numJobs parameter. - GHC -> GHC.replLib verbosity NoFlag pkg_descr lbi lib clbi - _ -> die "A REPL is not supported for this compiler." + GHC -> GHC.replLib verbosity NoFlag pkg_descr lbi lib clbi + GHCJS -> GHCJS.replLib verbosity NoFlag pkg_descr lbi lib clbi + _ -> die "A REPL is not supported for this compiler." replExe :: Verbosity -> PackageDescription -> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo -> IO () replExe verbosity pkg_descr lbi exe clbi = case compilerFlavor (compiler lbi) of - GHC -> GHC.replExe verbosity NoFlag pkg_descr lbi exe clbi - _ -> die "A REPL is not supported for this compiler." + GHC -> GHC.replExe verbosity NoFlag pkg_descr lbi exe clbi + GHCJS -> GHCJS.replExe verbosity NoFlag pkg_descr lbi exe clbi + _ -> die "A REPL is not supported for this compiler." initialBuildSteps :: FilePath -- ^"dist" prefix diff --git a/Distribution/Simple/Build/Macros.hs b/Distribution/Simple/Build/Macros.hs --- a/Distribution/Simple/Build/Macros.hs +++ b/Distribution/Simple/Build/Macros.hs @@ -30,8 +30,10 @@ ( Version(versionBranch) ) import Distribution.PackageDescription ( PackageDescription ) +import Distribution.Simple.Compiler + ( packageKeySupported ) import Distribution.Simple.LocalBuildInfo - ( LocalBuildInfo(withPrograms), externalPackageDeps ) + ( LocalBuildInfo(compiler, pkgKey, withPrograms), externalPackageDeps ) import Distribution.Simple.Program.Db ( configuredPrograms ) import Distribution.Simple.Program.Types @@ -49,7 +51,8 @@ generate _pkg_descr lbi = "/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n" ++ generatePackageVersionMacros (map snd (externalPackageDeps lbi)) ++ - generateToolVersionMacros (configuredPrograms . withPrograms $ lbi) + generateToolVersionMacros (configuredPrograms . withPrograms $ lbi) ++ + generatePackageKeyMacro lbi -- | Helper function that generates just the @VERSION_pkg@ and @MIN_VERSION_pkg@ -- macros for a list of package ids (usually used with the specific deps of @@ -92,6 +95,14 @@ ] where (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0) + +-- | Generate the @CURRENT_PACKAGE_KEY@ definition for the package key +-- of the current package, if supported by the compiler +generatePackageKeyMacro :: LocalBuildInfo -> String +generatePackageKeyMacro lbi + | packageKeySupported (compiler lbi) = + "#define CURRENT_PACKAGE_KEY \"" ++ display (pkgKey lbi) ++ "\"\n\n" + | otherwise = "" fixchar :: Char -> Char fixchar '-' = '_' diff --git a/Distribution/Simple/Build/PathsModule.hs b/Distribution/Simple/Build/PathsModule.hs --- a/Distribution/Simple/Build/PathsModule.hs +++ b/Distribution/Simple/Build/PathsModule.hs @@ -32,6 +32,8 @@ import Distribution.Simple.Setup ( CopyDest(NoCopyDest) ) import Distribution.Simple.BuildPaths ( autogenModuleName ) +import Distribution.Simple.Utils + ( shortRelativePath ) import Distribution.Text ( display ) import Distribution.Version @@ -49,7 +51,7 @@ generate :: PackageDescription -> LocalBuildInfo -> String generate pkg_descr lbi = let pragmas - | absolute || isHugs = "" + | absolute = "" | supports_language_pragma = "{-# LANGUAGE ForeignFunctionInterface #-}\n" | otherwise = @@ -58,11 +60,15 @@ foreign_imports | absolute = "" - | isHugs = "import System.Environment\n" | otherwise = "import Foreign\n"++ "import Foreign.C\n" + reloc_imports + | reloc = + "import System.Environment (getExecutablePath)\n" + | otherwise = "" + header = pragmas++ "module " ++ display paths_modulename ++ " (\n"++ @@ -75,15 +81,36 @@ "import qualified Control.Exception as Exception\n"++ "import Data.Version (Version(..))\n"++ "import System.Environment (getEnv)\n"++ + reloc_imports ++ "import Prelude\n"++ "\n"++ "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"++ "catchIO = Exception.catch\n" ++ "\n"++ - "\nversion :: Version"++ - "\nversion = " ++ show (packageVersion pkg_descr) + "version :: Version"++ + "\nversion = Version " ++ show branch ++ " " ++ show tags + where Version branch tags = packageVersion pkg_descr body + | reloc = + "\n\nbindirrel :: FilePath\n" ++ + "bindirrel = " ++ show flat_bindirreloc ++ + "\n"++ + "\ngetBinDir, getLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath\n"++ + "getBinDir = "++mkGetEnvOrReloc "bindir" flat_bindirreloc++"\n"++ + "getLibDir = "++mkGetEnvOrReloc "libdir" flat_libdirreloc++"\n"++ + "getDataDir = "++mkGetEnvOrReloc "datadir" flat_datadirreloc++"\n"++ + "getLibexecDir = "++mkGetEnvOrReloc "libexecdir" flat_libexecdirreloc++"\n"++ + "getSysconfDir = "++mkGetEnvOrReloc "sysconfdir" flat_sysconfdirreloc++"\n"++ + "\n"++ + "getDataFileName :: FilePath -> IO FilePath\n"++ + "getDataFileName name = do\n"++ + " dir <- getDataDir\n"++ + " return (dir `joinFileName` name)\n"++ + "\n"++ + get_prefix_reloc_stuff++ + "\n"++ + filename_stuff | absolute = "\nbindir, libdir, datadir, libexecdir, sysconfdir :: FilePath\n"++ "\nbindir = " ++ show flat_bindir ++ @@ -143,13 +170,23 @@ libdir = flat_libdirrel, datadir = flat_datadirrel, libexecdir = flat_libexecdirrel, - sysconfdir = flat_sysconfdirrel, - progdir = flat_progdirrel + sysconfdir = flat_sysconfdirrel } = prefixRelativeInstallDirs (packageId pkg_descr) lbi + flat_bindirreloc = shortRelativePath flat_prefix flat_bindir + flat_libdirreloc = shortRelativePath flat_prefix flat_libdir + flat_datadirreloc = shortRelativePath flat_prefix flat_datadir + flat_libexecdirreloc = shortRelativePath flat_prefix flat_libexecdir + flat_sysconfdirreloc = shortRelativePath flat_prefix flat_sysconfdir + mkGetDir _ (Just dirrel) = "getPrefixDirRel " ++ show dirrel mkGetDir dir Nothing = "return " ++ show dir + mkGetEnvOrReloc var dirrel = "catchIO (getEnv \""++var'++"\")" ++ + " (\\_ -> getPrefixDirReloc \"" ++ dirrel ++ + "\")" + where var' = pkgPathEnvVar pkg_descr var + mkGetEnvOr var expr = "catchIO (getEnv \""++var'++"\")"++ " (\\_ -> "++expr++")" where var' = pkgPathEnvVar pkg_descr var @@ -158,30 +195,29 @@ absolute = hasLibs pkg_descr -- we can only make progs relocatable || isNothing flat_bindirrel -- if the bin dir is an absolute path - || (isHugs && isNothing flat_progdirrel) || not (supportsRelocatableProgs (compilerFlavor (compiler lbi))) - supportsRelocatableProgs Hugs = True + reloc = relocatable lbi + supportsRelocatableProgs GHC = case buildOS of Windows -> True _ -> False + supportsRelocatableProgs GHCJS = case buildOS of + Windows -> True + _ -> False supportsRelocatableProgs _ = False paths_modulename = autogenModuleName pkg_descr - isHugs = compilerFlavor (compiler lbi) == Hugs - get_prefix_stuff - | isHugs = "progdirrel :: String\n"++ - "progdirrel = "++show (fromJust flat_progdirrel)++"\n\n"++ - get_prefix_hugs - | otherwise = get_prefix_win32 buildArch + get_prefix_stuff = get_prefix_win32 buildArch path_sep = show [pathSeparator] supports_language_pragma = - compilerFlavor (compiler lbi) == GHC && + (compilerFlavor (compiler lbi) == GHC && (compilerVersion (compiler lbi) - `withinRange` orLaterVersion (Version [6,6,1] [])) + `withinRange` orLaterVersion (Version [6,6,1] []))) || + compilerFlavor (compiler lbi) == GHCJS -- | Generates the name of the environment variable controlling the path -- component of interest. @@ -196,6 +232,14 @@ fixchar '-' = '_' fixchar c = c +get_prefix_reloc_stuff :: String +get_prefix_reloc_stuff = + "getPrefixDirReloc :: FilePath -> IO FilePath\n"++ + "getPrefixDirReloc dirRel = do\n"++ + " exePath <- getExecutablePath\n"++ + " let (bindir,_) = splitFileName exePath\n"++ + " return ((bindir `minusFileName` bindirrel) `joinFileName` dirRel)\n" + get_prefix_win32 :: Arch -> String get_prefix_win32 arch = "getPrefixDirRel :: FilePath -> IO FilePath\n"++ @@ -217,15 +261,6 @@ I386 -> "stdcall" X86_64 -> "ccall" _ -> error "win32 supported only with I386, X86_64" - -get_prefix_hugs :: String -get_prefix_hugs = - "getPrefixDirRel :: FilePath -> IO FilePath\n"++ - "getPrefixDirRel dirRel = do\n"++ - " mainPath <- getProgName\n"++ - " let (progPath,_) = splitFileName mainPath\n"++ - " let (progdir,_) = splitFileName progPath\n"++ - " return ((progdir `minusFileName` progdirrel) `joinFileName` dirRel)\n" filename_stuff :: String filename_stuff = diff --git a/Distribution/Simple/BuildPaths.hs b/Distribution/Simple/BuildPaths.hs --- a/Distribution/Simple/BuildPaths.hs +++ b/Distribution/Simple/BuildPaths.hs @@ -107,9 +107,8 @@ Windows -> "exe" _ -> "" --- ToDo: This should be determined via autoconf (AC_OBJEXT) --- | Extension for object files. For GHC and NHC the extension is @\"o\"@. --- Hugs uses either @\"o\"@ or @\"obj\"@ depending on the used C compiler. +-- TODO: This should be determined via autoconf (AC_OBJEXT) +-- | Extension for object files. For GHC the extension is @\"o\"@. objExtension :: String objExtension = "o" diff --git a/Distribution/Simple/BuildTarget.hs b/Distribution/Simple/BuildTarget.hs --- a/Distribution/Simple/BuildTarget.hs +++ b/Distribution/Simple/BuildTarget.hs @@ -426,7 +426,8 @@ cinfoSrcDirs :: [FilePath], cinfoModules :: [ModuleName], cinfoHsFiles :: [FilePath], -- other hs files (like main.hs) - cinfoCFiles :: [FilePath] + cinfoCFiles :: [FilePath], + cinfoJsFiles :: [FilePath] } type ComponentStringName = String @@ -439,7 +440,8 @@ cinfoSrcDirs = hsSourceDirs bi, cinfoModules = componentModules c, cinfoHsFiles = componentHsFiles c, - cinfoCFiles = cSources bi + cinfoCFiles = cSources bi, + cinfoJsFiles = jsSources bi } | c <- pkgComponents pkg , let bi = componentBuildInfo c ] @@ -658,12 +660,14 @@ , matchOtherFileRooted dirs hsFiles str ]) (msum [ matchModuleFileUnrooted ms str , matchOtherFileUnrooted hsFiles str - , matchOtherFileUnrooted cFiles str ])) + , matchOtherFileUnrooted cFiles str + , matchOtherFileUnrooted jsFiles str ])) where dirs = cinfoSrcDirs c ms = cinfoModules c hsFiles = cinfoHsFiles c cFiles = cinfoCFiles c + jsFiles = cinfoJsFiles c -- utils diff --git a/Distribution/Simple/Command.hs b/Distribution/Simple/Command.hs --- a/Distribution/Simple/Command.hs +++ b/Distribution/Simple/Command.hs @@ -22,10 +22,14 @@ commandShowOptions, CommandParse(..), commandParseArgs, + getNormalCommandDescriptions, + helpCommandUI, -- ** Constructing commands ShowOrParseArgs(..), - makeCommand, + usageDefault, + usageAlternatives, + mkCommandUI, hiddenCommand, -- ** Associating actions with commands @@ -66,7 +70,8 @@ import Distribution.ParseUtils import Distribution.ReadE import Distribution.Simple.Utils (die, intercalate) -import Text.PrettyPrint ( punctuate, cat, comma, text, empty) +import Text.PrettyPrint ( punctuate, cat, comma, text ) +import Text.PrettyPrint as PP ( empty ) data CommandUI flags = CommandUI { -- | The name of the command as it would be entered on the command line. @@ -79,6 +84,8 @@ commandUsage :: String -> String, -- | Additional explanation of the command to use in help texts. commandDescription :: Maybe (String -> String), + -- | Post-Usage notes and examples in help texts + commandNotes :: Maybe (String -> String), -- | Initial \/ empty flags commandDefaultFlags :: flags, -- | All the Option fields for this command @@ -258,15 +265,15 @@ (cat . punctuate comma . map text . ppr) t OptArg _ _ _ _ _ ppr -> - case ppr t of [] -> empty + case ppr t of [] -> PP.empty (Nothing : _) -> text "True" (Just a : _) -> text a ChoiceOpt alts -> - fromMaybe empty $ listToMaybe + fromMaybe PP.empty $ listToMaybe [ text lf | (_,(_,lf:_), _,enabled) <- alts, enabled t] - BoolOpt _ _ _ _ enabled -> (maybe empty disp . enabled) t + BoolOpt _ _ _ _ enabled -> (maybe PP.empty disp . enabled) t -- set :: LineNo -> String -> a -> ParseResult a set line val a = @@ -371,32 +378,55 @@ -- | The help text for this command with descriptions of all the options. commandHelp :: CommandUI flags -> String -> String commandHelp command pname = - commandUsage command pname - ++ (GetOpt.usageInfo "" - . addCommonFlags ShowArgs - $ commandGetOpts ShowArgs command) - ++ case commandDescription command of - Nothing -> "" - Just desc -> '\n': desc pname + commandSynopsis command + ++ "\n\n" + ++ commandUsage command pname + ++ ( case commandDescription command of + Nothing -> "" + Just desc -> '\n': desc pname) + ++ "\n" + ++ ( if cname == "" + then "Global flags:" + else "Flags for " ++ cname ++ ":" ) + ++ ( GetOpt.usageInfo "" + . addCommonFlags ShowArgs + $ commandGetOpts ShowArgs command ) + ++ ( case commandNotes command of + Nothing -> "" + Just notes -> '\n': notes pname) + where cname = commandName command +-- | Default "usage" documentation text for commands. +usageDefault :: String -> String -> String +usageDefault name pname = + "Usage: " ++ pname ++ " " ++ name ++ " [FLAGS]\n\n" + ++ "Flags for " ++ name ++ ":" + +-- | Create "usage" documentation from a list of parameter +-- configurations. +usageAlternatives :: String -> [String] -> String -> String +usageAlternatives name strs pname = unlines + [ start ++ pname ++ " " ++ name ++ " " ++ s + | let starts = "Usage: " : repeat " or: " + , (start, s) <- zip starts strs + ] + -- | Make a Command from standard 'GetOpt' options. -makeCommand :: String -- ^ name - -> String -- ^ short description - -> Maybe (String -> String) -- ^ long description - -> flags -- ^ initial\/empty flags +mkCommandUI :: String -- ^ name + -> String -- ^ synopsis + -> [String] -- ^ usage alternatives + -> flags -- ^ initial\/empty flags -> (ShowOrParseArgs -> [OptionField flags]) -- ^ options -> CommandUI flags -makeCommand name shortDesc longDesc defaultFlags options = - CommandUI { - commandName = name, - commandSynopsis = shortDesc, - commandDescription = longDesc, - commandUsage = usage, - commandDefaultFlags = defaultFlags, - commandOptions = options +mkCommandUI name synopsis usages flags options = CommandUI + { commandName = name + , commandSynopsis = synopsis + , commandDescription = Nothing + , commandNotes = Nothing + , commandUsage = usageAlternatives name usages + , commandDefaultFlags = flags + , commandOptions = options } - where usage pname = "Usage: " ++ pname ++ " " ++ name ++ " [FLAGS]\n\n" - ++ "Flags for " ++ name ++ ":" -- | Common flags that apply to every command data CommonFlag = HelpFlag | ListOptionsFlag @@ -501,7 +531,7 @@ -> [String] -> CommandParse (a, CommandParse action) commandsRun globalCommand commands args = - case commandParseArgs globalCommand' True args of + case commandParseArgs globalCommand True args of CommandHelp help -> CommandHelp help CommandList opts -> CommandList (opts ++ commandNames) CommandErrors errs -> CommandErrors errs @@ -522,25 +552,6 @@ ++ " (try --help)\n"] commands' = commands ++ [commandAddAction helpCommandUI undefined] commandNames = [ name | (Command name _ _ NormalCommand) <- commands' ] - globalCommand' = globalCommand { - commandUsage = \pname -> - (case commandUsage globalCommand pname of - "" -> "" - original -> original ++ "\n") - ++ "Usage: " ++ pname ++ " COMMAND [FLAGS]\n" - ++ " or: " ++ pname ++ " [GLOBAL FLAGS]\n\n" - ++ "Global flags:", - commandDescription = Just $ \pname -> - "Commands:\n" - ++ unlines [ " " ++ align name ++ " " ++ description - | Command name description _ NormalCommand <- commands' ] - ++ case commandDescription globalCommand of - Nothing -> "" - Just desc -> '\n': desc pname - } - where maxlen = maximum - [ length name | Command name _ _ NormalCommand <- commands' ] - align str = str ++ replicate (maxlen - length str) ' ' -- A bit of a hack: support "prog help" as a synonym of "prog --help" -- furthermore, support "prog help command" as "prog command --help" @@ -559,14 +570,7 @@ _ -> CommandHelp globalHelp _ -> badCommand name - where globalHelp = commandHelp globalCommand' - helpCommandUI = - (makeCommand "help" "Help about commands." Nothing () (const [])) { - commandUsage = \pname -> - "Usage: " ++ pname ++ " help [FLAGS]\n" - ++ " or: " ++ pname ++ " help COMMAND [FLAGS]\n\n" - ++ "Flags for help:" - } + where globalHelp = commandHelp globalCommand -- | Utility function, many commands do not accept additional flags. This -- action fails with a helpful error message if the user supplies any extra. @@ -577,3 +581,17 @@ die $ "Unrecognised flags: " ++ intercalate ", " extraFlags --TODO: eliminate this function and turn it into a variant on commandAddAction -- instead like commandAddActionNoArgs that doesn't supply the [String] + +-- | Helper function for creating globalCommand description +getNormalCommandDescriptions :: [Command action] -> [(String, String)] +getNormalCommandDescriptions cmds = + [ (name, description) + | Command name description _ NormalCommand <- cmds ] + +helpCommandUI :: CommandUI () +helpCommandUI = mkCommandUI + "help" + "Help about commands." + ["[FLAGS]", "COMMAND [FLAGS]"] + () + (const []) diff --git a/Distribution/Simple/Compiler.hs b/Distribution/Simple/Compiler.hs --- a/Distribution/Simple/Compiler.hs +++ b/Distribution/Simple/Compiler.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.Compiler @@ -22,7 +24,10 @@ -- * Haskell implementations module Distribution.Compiler, Compiler(..), - showCompilerId, compilerFlavor, compilerVersion, + showCompilerId, showCompilerIdWithAbi, + compilerFlavor, compilerVersion, + compilerCompatVersion, + compilerInfo, -- * Support for package databases PackageDB(..), @@ -35,13 +40,20 @@ OptimisationLevel(..), flagToOptimisationLevel, + -- * Support for debug info levels + DebugInfoLevel(..), + flagToDebugInfoLevel, + -- * Support for language extensions Flag, languageToFlags, unsupportedLanguages, extensionsToFlags, unsupportedExtensions, - parmakeSupported + parmakeSupported, + reexportedModulesSupported, + renamingPackageFlagsSupported, + packageKeySupported ) where import Distribution.Compiler @@ -50,14 +62,20 @@ import Language.Haskell.Extension (Language(Haskell98), Extension) import Control.Monad (liftM) +import Data.Binary (Binary) import Data.List (nub) import qualified Data.Map as M (Map, lookup) -import Data.Maybe (catMaybes, isNothing) +import Data.Maybe (catMaybes, isNothing, listToMaybe) +import GHC.Generics (Generic) import System.Directory (canonicalizePath) data Compiler = Compiler { compilerId :: CompilerId, -- ^ Compiler flavour and version. + compilerAbiTag :: AbiTag, + -- ^ Tag for distinguishing incompatible ABI's on the same architecture/os. + compilerCompat :: [CompilerId], + -- ^ Other implementations that this compiler claims to be compatible with. compilerLanguages :: [(Language, Flag)], -- ^ Supported language standards. compilerExtensions :: [(Extension, Flag)], @@ -65,17 +83,39 @@ compilerProperties :: M.Map String String -- ^ A key-value map for properties not covered by the above fields. } - deriving (Show, Read) + deriving (Generic, Show, Read) +instance Binary Compiler + showCompilerId :: Compiler -> String showCompilerId = display . compilerId +showCompilerIdWithAbi :: Compiler -> String +showCompilerIdWithAbi comp = + display (compilerId comp) ++ + case compilerAbiTag comp of + NoAbiTag -> [] + AbiTag xs -> '-':xs + compilerFlavor :: Compiler -> CompilerFlavor compilerFlavor = (\(CompilerId f _) -> f) . compilerId compilerVersion :: Compiler -> Version compilerVersion = (\(CompilerId _ v) -> v) . compilerId +compilerCompatVersion :: CompilerFlavor -> Compiler -> Maybe Version +compilerCompatVersion flavor comp + | compilerFlavor comp == flavor = Just (compilerVersion comp) + | otherwise = + listToMaybe [ v | CompilerId fl v <- compilerCompat comp, fl == flavor ] + +compilerInfo :: Compiler -> CompilerInfo +compilerInfo c = CompilerInfo (compilerId c) + (compilerAbiTag c) + (Just . compilerCompat $ c) + (Just . map fst . compilerLanguages $ c) + (Just . map fst . compilerExtensions $ c) + -- ------------------------------------------------------------ -- * Package databases -- ------------------------------------------------------------ @@ -90,8 +130,10 @@ data PackageDB = GlobalPackageDB | UserPackageDB | SpecificPackageDB FilePath - deriving (Eq, Ord, Show, Read) + deriving (Eq, Generic, Ord, Show, Read) +instance Binary PackageDB + -- | We typically get packages from several databases, and stack them -- together. This type lets us be explicit about that stacking. For example -- typical stacks include: @@ -134,14 +176,16 @@ -- ------------------------------------------------------------ -- | Some compilers support optimising. Some have different levels. --- For compliers that do not the level is just capped to the level +-- For compilers that do not the level is just capped to the level -- they do support. -- data OptimisationLevel = NoOptimisation | NormalOptimisation | MaximumOptimisation - deriving (Eq, Show, Read, Enum, Bounded) + deriving (Bounded, Enum, Eq, Generic, Read, Show) +instance Binary OptimisationLevel + flagToOptimisationLevel :: Maybe String -> OptimisationLevel flagToOptimisationLevel Nothing = NormalOptimisation flagToOptimisationLevel (Just s) = case reads s of @@ -154,6 +198,33 @@ _ -> error $ "Can't parse optimisation level " ++ s -- ------------------------------------------------------------ +-- * Debug info levels +-- ------------------------------------------------------------ + +-- | Some compilers support emitting debug info. Some have different +-- levels. For compilers that do not the level is just capped to the +-- level they do support. +-- +data DebugInfoLevel = NoDebugInfo + | MinimalDebugInfo + | NormalDebugInfo + | MaximalDebugInfo + deriving (Bounded, Enum, Eq, Generic, Read, Show) + +instance Binary DebugInfoLevel + +flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel +flagToDebugInfoLevel Nothing = NormalDebugInfo +flagToDebugInfoLevel (Just s) = case reads s of + [(i, "")] + | i >= fromEnum (minBound :: DebugInfoLevel) + && i <= fromEnum (maxBound :: DebugInfoLevel) + -> toEnum i + | otherwise -> error $ "Bad debug info level: " ++ show i + ++ ". Valid values are 0..3" + _ -> error $ "Can't parse debug info level " ++ s + +-- ------------------------------------------------------------ -- * Languages and Extensions -- ------------------------------------------------------------ @@ -189,9 +260,28 @@ -- | Does this compiler support parallel --make mode? parmakeSupported :: Compiler -> Bool -parmakeSupported comp = +parmakeSupported = ghcSupported "Support parallel --make" + +-- | Does this compiler support reexported-modules? +reexportedModulesSupported :: Compiler -> Bool +reexportedModulesSupported = ghcSupported "Support reexported-modules" + +-- | Does this compiler support thinning/renaming on package flags? +renamingPackageFlagsSupported :: Compiler -> Bool +renamingPackageFlagsSupported = ghcSupported "Support thinning and renaming package flags" + +-- | Does this compiler support package keys? +packageKeySupported :: Compiler -> Bool +packageKeySupported = ghcSupported "Uses package keys" + +-- | Utility function for GHC only features +ghcSupported :: String -> Compiler -> Bool +ghcSupported key comp = case compilerFlavor comp of - GHC -> case M.lookup "Support parallel --make" (compilerProperties comp) of - Just "YES" -> True - _ -> False - _ -> False + GHC -> checkProp + GHCJS -> checkProp + _ -> False + where checkProp = + case M.lookup key (compilerProperties comp) of + Just "YES" -> True + _ -> False diff --git a/Distribution/Simple/Configure.hs b/Distribution/Simple/Configure.hs --- a/Distribution/Simple/Configure.hs +++ b/Distribution/Simple/Configure.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.Configure @@ -23,6 +27,7 @@ module Distribution.Simple.Configure (configure, writePersistBuildConfig, + getConfigStateFile, getPersistBuildConfig, checkPersistBuildConfigOutdated, tryGetPersistBuildConfig, @@ -34,9 +39,7 @@ ccLdOptionsBuildInfo, checkForeignDeps, interpretPackageDbFlags, - - ConfigStateFileErrorType(..), - ConfigStateFileError, + ConfigStateFileError(..), tryGetConfigStateFile, platformDefines, ) @@ -44,41 +47,47 @@ import Distribution.Compiler ( CompilerId(..) ) +import Distribution.Utils.NubList import Distribution.Simple.Compiler - ( CompilerFlavor(..), Compiler(compilerId), compilerFlavor, compilerVersion + ( CompilerFlavor(..), Compiler(..), compilerFlavor, compilerVersion + , compilerInfo , showCompilerId, unsupportedLanguages, unsupportedExtensions - , PackageDB(..), PackageDBStack ) + , PackageDB(..), PackageDBStack, reexportedModulesSupported + , packageKeySupported, renamingPackageFlagsSupported ) import Distribution.Simple.PreProcess ( platformDefines ) import Distribution.Package ( PackageName(PackageName), PackageIdentifier(..), PackageId , packageName, packageVersion, Package(..) , Dependency(Dependency), simplifyDependency - , InstalledPackageId(..), thisPackageVersion ) -import Distribution.InstalledPackageInfo as Installed - ( InstalledPackageInfo, InstalledPackageInfo_(..) - , emptyInstalledPackageInfo ) + , InstalledPackageId(..), thisPackageVersion + , mkPackageKey, PackageKey(..) ) +import qualified Distribution.InstalledPackageInfo as Installed +import Distribution.InstalledPackageInfo (InstalledPackageInfo, emptyInstalledPackageInfo) import qualified Distribution.Simple.PackageIndex as PackageIndex -import Distribution.Simple.PackageIndex (PackageIndex) +import Distribution.Simple.PackageIndex (InstalledPackageIndex) import Distribution.PackageDescription as PD ( PackageDescription(..), specVersion, GenericPackageDescription(..) , Library(..), hasLibs, Executable(..), BuildInfo(..), allExtensions , HookedBuildInfo, updatePackageDescription, allBuildInfo - , Flag(flagName), FlagName(..), TestSuite(..), Benchmark(..) ) + , Flag(flagName), FlagName(..), TestSuite(..), Benchmark(..) + , ModuleReexport(..) , defaultRenaming ) +import Distribution.ModuleName + ( ModuleName ) import Distribution.PackageDescription.Configuration ( finalizePackageDescription, mapTreeData ) import Distribution.PackageDescription.Check ( PackageCheck(..), checkPackage, checkPackageFiles ) -import Distribution.Simple.Hpc ( enableCoverage ) import Distribution.Simple.Program ( Program(..), ProgramLocation(..), ConfiguredProgram(..) , ProgramConfiguration, defaultProgramConfiguration , ProgramSearchPathEntry(..), getProgramSearchPath, setProgramSearchPath , configureAllKnownPrograms, knownPrograms, lookupKnownProgram , userSpecifyArgss, userSpecifyPaths - , requireProgram, requireProgramVersion + , lookupProgram, requireProgram, requireProgramVersion , pkgConfigProgram, gccProgram, rawSystemProgramStdoutConf ) import Distribution.Simple.Setup - ( ConfigFlags(..), CopyDest(..), fromFlag, fromFlagOrDefault, flagToMaybe ) + ( ConfigFlags(..), CopyDest(..), Flag(..), fromFlag, fromFlagOrDefault + , flagToMaybe ) import Distribution.Simple.InstallDirs ( InstallDirs(..), defaultInstallDirs, combineInstallDirs ) import Distribution.Simple.LocalBuildInfo @@ -93,33 +102,46 @@ ( die, warn, info, setupMessage , createDirectoryIfMissingVerbose, moreRecentFile , intercalate, cabalVersion - , withFileContents, writeFileAtomic + , writeFileAtomic , withTempFile ) import Distribution.System - ( OS(..), buildOS, Platform, buildPlatform ) + ( OS(..), buildOS, Platform (..), buildPlatform ) import Distribution.Version ( Version(..), anyVersion, orLaterVersion, withinRange, isAnyVersion ) import Distribution.Verbosity ( Verbosity, lessVerbose ) -import qualified Distribution.Simple.GHC as GHC -import qualified Distribution.Simple.JHC as JHC -import qualified Distribution.Simple.LHC as LHC -import qualified Distribution.Simple.NHC as NHC -import qualified Distribution.Simple.Hugs as Hugs -import qualified Distribution.Simple.UHC as UHC +import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.GHCJS as GHCJS +import qualified Distribution.Simple.JHC as JHC +import qualified Distribution.Simple.LHC as LHC +import qualified Distribution.Simple.UHC as UHC import qualified Distribution.Simple.HaskellSuite as HaskellSuite +-- Prefer the more generic Data.Traversable.mapM to Prelude.mapM +import Prelude hiding ( mapM ) +import Control.Exception + ( ErrorCall(..), Exception, evaluate, throw, throwIO, try ) import Control.Monad - ( when, unless, foldM, filterM ) + ( liftM, when, unless, foldM, filterM ) +import Data.Binary ( decodeOrFail, encode ) +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy.Char8 as BLC8 import Data.List - ( (\\), nub, partition, isPrefixOf, inits ) + ( (\\), nub, partition, isPrefixOf, inits, stripPrefix ) import Data.Maybe - ( isNothing, catMaybes, fromMaybe ) + ( isNothing, catMaybes, fromMaybe, isJust ) +import Data.Either + ( partitionEithers ) +import qualified Data.Set as Set import Data.Monoid ( Monoid(..) ) import qualified Data.Map as Map import Data.Map (Map) +import Data.Traversable + ( mapM ) +import Data.Typeable import System.Directory ( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory ) import System.FilePath @@ -135,90 +157,97 @@ , quotes, punctuate, nest, sep, hsep ) import Distribution.Compat.Exception ( catchExit, catchIO ) -import qualified Data.ByteString.Lazy.Char8 as BS.Char8 +data ConfigStateFileError + = ConfigStateFileNoHeader + | ConfigStateFileBadHeader + | ConfigStateFileNoParse + | ConfigStateFileMissing + | ConfigStateFileBadVersion PackageIdentifier PackageIdentifier (Either ConfigStateFileError LocalBuildInfo) + deriving (Typeable) -data ConfigStateFileErrorType = ConfigStateFileCantParse - | ConfigStateFileMissing - | ConfigStateFileBadVersion - deriving Eq -type ConfigStateFileError = (String, ConfigStateFileErrorType) +instance Show ConfigStateFileError where + show ConfigStateFileNoHeader = + "Saved package config file header is missing. " + ++ "Try re-running the 'configure' command." + show ConfigStateFileBadHeader = + "Saved package config file header is corrupt. " + ++ "Try re-running the 'configure' command." + show ConfigStateFileNoParse = + "Saved package config file body is corrupt. " + ++ "Try re-running the 'configure' command." + show ConfigStateFileMissing = "Run the 'configure' command first." + show (ConfigStateFileBadVersion oldCabal oldCompiler _) = + "You need to re-run the 'configure' command. " + ++ "The version of Cabal being used has changed (was " + ++ display oldCabal ++ ", now " + ++ display currentCabalId ++ ")." + ++ badCompiler + where + badCompiler + | oldCompiler == currentCompilerId = "" + | otherwise = + " Additionally the compiler is different (was " + ++ display oldCompiler ++ ", now " + ++ display currentCompilerId + ++ ") which is probably the cause of the problem." -tryGetConfigStateFile :: (Read a) => FilePath - -> IO (Either ConfigStateFileError a) -tryGetConfigStateFile filename = do - exists <- doesFileExist filename - if not exists - then return (Left (missing, ConfigStateFileMissing)) - else withFileContents filename $ \str -> - case lines str of - [header, rest] -> case checkHeader header of - Just err -> return (Left err) - Nothing -> case reads rest of - [(bi,_)] -> return (Right bi) - _ -> return (Left (cantParse, ConfigStateFileCantParse)) - _ -> return (Left (cantParse, ConfigStateFileCantParse)) - where - checkHeader :: String -> Maybe ConfigStateFileError - checkHeader header = case parseHeader header of - Just (cabalId, compId) - | cabalId - == currentCabalId -> Nothing - | otherwise -> Just (badVersion cabalId compId - ,ConfigStateFileBadVersion) - Nothing -> Just (cantParse - ,ConfigStateFileCantParse) +instance Exception ConfigStateFileError - missing = "Run the 'configure' command first." - cantParse = "Saved package config file seems to be corrupt. " - ++ "Try re-running the 'configure' command." - badVersion cabalId compId - = "You need to re-run the 'configure' command. " - ++ "The version of Cabal being used has changed (was " - ++ display cabalId ++ ", now " - ++ display currentCabalId ++ ")." - ++ badcompiler compId - badcompiler compId | compId == currentCompilerId = "" - | otherwise - = " Additionally the compiler is different (was " - ++ display compId ++ ", now " - ++ display currentCompilerId - ++ ") which is probably the cause of the problem." +getConfigStateFile :: FilePath -> IO LocalBuildInfo +getConfigStateFile filename = do + exists <- doesFileExist filename + unless exists $ throwIO ConfigStateFileMissing + -- Read the config file into a strict ByteString to avoid problems with + -- lazy I/O, then convert to lazy because the binary package needs that. + contents <- BS.readFile filename + let (header, body) = BLC8.span (/='\n') (BLC8.fromChunks [contents]) + headerParseResult <- try $ evaluate $ parseHeader header + let (cabalId, compId) = + case headerParseResult of + Left (ErrorCall _) -> throw ConfigStateFileBadHeader + Right x -> x + + let getStoredValue = evaluate $ + case decodeOrFail (BLC8.tail body) of + Left _ -> throw ConfigStateFileNoParse + Right (_, _, x) -> x + deferErrorIfBadVersion act + | cabalId /= currentCabalId = do + eResult <- try act + throw $ ConfigStateFileBadVersion cabalId compId eResult + | otherwise = act + deferErrorIfBadVersion getStoredValue + +tryGetConfigStateFile :: FilePath + -> IO (Either ConfigStateFileError LocalBuildInfo) +tryGetConfigStateFile = try . getConfigStateFile + -- |Try to read the 'localBuildInfoFile'. tryGetPersistBuildConfig :: FilePath - -> IO (Either ConfigStateFileError LocalBuildInfo) -tryGetPersistBuildConfig distPref - = tryGetConfigStateFile (localBuildInfoFile distPref) + -> IO (Either ConfigStateFileError LocalBuildInfo) +tryGetPersistBuildConfig = try . getPersistBuildConfig --- |Read the 'localBuildInfoFile'. Error if it doesn't exist. Also --- fail if the file containing LocalBuildInfo is older than the .cabal --- file, indicating that a re-configure is required. +-- | Read the 'localBuildInfoFile'. Throw an exception if the file is +-- missing, if the file cannot be read, or if the file was created by an older +-- version of Cabal. getPersistBuildConfig :: FilePath -> IO LocalBuildInfo -getPersistBuildConfig distPref = do - lbi <- tryGetPersistBuildConfig distPref - either (die . fst) return lbi +getPersistBuildConfig = getConfigStateFile . localBuildInfoFile -- |Try to read the 'localBuildInfoFile'. maybeGetPersistBuildConfig :: FilePath -> IO (Maybe LocalBuildInfo) -maybeGetPersistBuildConfig distPref = do - lbi <- tryGetPersistBuildConfig distPref - return $ either (const Nothing) Just lbi +maybeGetPersistBuildConfig = + liftM (either (const Nothing) Just) . tryGetPersistBuildConfig -- |After running configure, output the 'LocalBuildInfo' to the -- 'localBuildInfoFile'. writePersistBuildConfig :: FilePath -> LocalBuildInfo -> IO () writePersistBuildConfig distPref lbi = do - createDirectoryIfMissing False distPref - writeFileAtomic (localBuildInfoFile distPref) - (BS.Char8.pack $ showHeader pkgid ++ '\n' : show lbi) + createDirectoryIfMissing False distPref + writeFileAtomic (localBuildInfoFile distPref) $ + BLC8.unlines [showHeader pkgId, encode lbi] where - pkgid = packageId (localPkgDescr lbi) - -showHeader :: PackageIdentifier -> String -showHeader pkgid = - "Saved package config for " ++ display pkgid - ++ " written by " ++ display currentCabalId - ++ " using " ++ display currentCompilerId + pkgId = packageId $ localPkgDescr lbi currentCabalId :: PackageIdentifier currentCabalId = PackageIdentifier (PackageName "Cabal") cabalVersion @@ -227,19 +256,26 @@ currentCompilerId = PackageIdentifier (PackageName System.Info.compilerName) System.Info.compilerVersion -parseHeader :: String -> Maybe (PackageIdentifier, PackageIdentifier) -parseHeader header = case words header of - ["Saved", "package", "config", "for", pkgid, - "written", "by", cabalid, "using", compilerid] - -> case (simpleParse pkgid :: Maybe PackageIdentifier, - simpleParse cabalid, - simpleParse compilerid) of - (Just _, - Just cabalid', - Just compilerid') -> Just (cabalid', compilerid') - _ -> Nothing - _ -> Nothing +parseHeader :: ByteString -> (PackageIdentifier, PackageIdentifier) +parseHeader header = case BLC8.words header of + ["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) + compId' <- simpleParse (BLC8.unpack compId) + return (cabalId', compId') + _ -> throw ConfigStateFileNoHeader +showHeader :: PackageIdentifier -> ByteString +showHeader pkgId = BLC8.unwords + [ "Saved", "package", "config", "for" + , BLC8.pack $ display pkgId + , "written", "by" + , BLC8.pack $ display currentCabalId + , "using" + , BLC8.pack $ display currentCompilerId + ] + -- |Check that localBuildInfoFile is up-to-date with respect to the -- .cabal file. checkPersistBuildConfigOutdated :: FilePath -> FilePath -> IO Bool @@ -259,7 +295,13 @@ configure :: (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo configure (pkg_descr0, pbi) cfg - = do let distPref = fromFlag (configDistPref cfg) + = do unless (configLibCoverage cfg == NoFlag) $ do + let enable | fromFlag (configLibCoverage cfg) = "enable" + | otherwise = "disable" + die $ "Option --" ++ enable ++ "-library-coverage is obsolete! " + ++ "Please use --" ++ enable ++ "-coverage instead." + + let distPref = fromFlag (configDistPref cfg) buildDir' = distPref "build" verbosity = fromFlag (configVerbosity cfg) @@ -353,7 +395,7 @@ (configConfigurationsFlags cfg) dependencySatisfiable compPlatform - (compilerId comp) + (compilerInfo comp) allConstraints pkg_descr0'' of Right r -> return r @@ -376,18 +418,32 @@ -- add extra include/lib dirs as specified in cfg -- we do it here so that those get checked too - let pkg_descr = - enableCoverage (fromFlag (configLibCoverage cfg)) distPref - $ addExtraIncludeLibDirs pkg_descr0' + let pkg_descr = addExtraIncludeLibDirs pkg_descr0' + unless (renamingPackageFlagsSupported comp || + and [ rn == defaultRenaming + | bi <- allBuildInfo pkg_descr + , rn <- Map.elems (targetBuildRenaming bi)]) $ + die $ "Your compiler does not support thinning and renaming on " + ++ "package flags. To use this feature you probably must use " + ++ "GHC 7.9 or later." + when (not (null flags)) $ info verbosity $ "Flags chosen: " ++ intercalate ", " [ name ++ "=" ++ display value | (FlagName name, value) <- flags ] + when (maybe False (not.null.PD.reexportedModules) (PD.library pkg_descr) + && not (reexportedModulesSupported comp)) $ do + die $ "Your compiler does not support module re-exports. To use " + ++ "this feature you probably must use GHC 7.9 or later." + checkPackageProblems verbosity pkg_descr0 (updatePackageDescription pbi pkg_descr) + -- Handle hole instantiation + (holeDeps, hole_insts) <- configureInstantiateWith pkg_descr cfg installedPackageSet + let selectDependencies :: [Dependency] -> ([FailedDependency], [ResolvedDependency]) selectDependencies = @@ -414,9 +470,14 @@ reportFailedDependencies failedDeps reportSelectedDependencies verbosity allPkgDeps + let installDeps = Map.elems + . Map.fromList + . map (\v -> (Installed.installedPackageId v, v)) + $ externalPkgDeps ++ holeDeps + packageDependsIndex <- case PackageIndex.dependencyClosure installedPackageSet - (map Installed.installedPackageId externalPkgDeps) of + (map Installed.installedPackageId installDeps) of Left packageDependsIndex -> return packageDependsIndex Right broken -> die $ "The following installed packages are broken because other" @@ -433,7 +494,7 @@ InstalledPackageId (display (packageId pkg_descr)), Installed.sourcePackageId = packageId pkg_descr, Installed.depends = - map Installed.installedPackageId externalPkgDeps + map Installed.installedPackageId installDeps } case PackageIndex.dependencyInconsistencies . PackageIndex.insert pseudoTopPkg @@ -448,12 +509,26 @@ | (name, uses) <- inconsistencies , (pkg, ver) <- uses ] + -- Calculate the package key. We're going to store it in LocalBuildInfo + -- canonically, but ComponentsLocalBuildInfo also needs to know about it + -- XXX Do we need the internal deps? + -- NB: does *not* include holeDeps! + let pkg_key = mkPackageKey (packageKeySupported comp) + (package pkg_descr) + (map Installed.packageKey externalPkgDeps) + (map (\(k,(p,m)) -> (k,(Installed.packageKey p,m))) hole_insts) + -- internal component graph buildComponents <- - case mkComponentsLocalBuildInfo pkg_descr - internalPkgDeps externalPkgDeps of + case mkComponentsGraph pkg_descr internalPkgDeps of Left componentCycle -> reportComponentCycle componentCycle - Right components -> return components + Right components -> + case mkComponentsLocalBuildInfo packageDependsIndex pkg_descr + internalPkgDeps externalPkgDeps holeDeps + (Map.fromList hole_insts) + pkg_key components of + Left problems -> reportModuleReexportProblems problems + Right components' -> return components' -- installation directories defaultDirs <- defaultInstallDirs flavor userInstall (hasLibs pkg_descr) @@ -504,19 +579,65 @@ then return False else case flavor of GHC | version >= Version [6,5] [] -> return True + GHCJS -> return True _ -> do warn verbosity ("this compiler does not support " ++ "--enable-split-objs; ignoring") return False - let sharedLibsByDefault = + let ghciLibByDefault = case compilerId comp of CompilerId GHC _ -> + -- If ghc is non-dynamic, then ghci needs object files, + -- so we build one by default. + -- + -- Technically, archive files should be sufficient for ghci, + -- but because of GHC bug #8942, it has never been safe to + -- rely on them. By the time that bug was fixed, ghci had + -- been changed to read shared libraries instead of archive + -- files (see next code block). + not (GHC.isDynamic comp) + CompilerId GHCJS _ -> + not (GHCJS.isDynamic comp) + _ -> False + + let sharedLibsByDefault + | fromFlag (configDynExe cfg) = + -- build a shared library if dynamically-linked + -- executables are requested + True + | otherwise = case compilerId comp of + CompilerId GHC _ -> -- if ghc is dynamic, then ghci needs a shared -- library, so we build one by default. - GHC.ghcDynamic comp + GHC.isDynamic comp + CompilerId GHCJS _ -> + GHCJS.isDynamic comp _ -> False + withSharedLib_ = + -- build shared libraries if required by GHC or by the + -- executable linking mode, but allow the user to force + -- building only static library archives with + -- --disable-shared. + fromFlagOrDefault sharedLibsByDefault $ configSharedLib cfg + withDynExe_ = fromFlag $ configDynExe cfg + when (withDynExe_ && not withSharedLib_) $ warn verbosity $ + "Executables will use dynamic linking, but a shared library " + ++ "is not being built. Linking will fail if any executables " + ++ "depend on the library." + let withProfExe_ = fromFlagOrDefault False $ configProfExe cfg + withProfLib_ = fromFlagOrDefault withProfExe_ $ configProfLib cfg + when (withProfExe_ && not withProfLib_) $ warn verbosity $ + "Executables will be built with profiling, but library " + ++ "profiling is disabled. Linking will fail if any executables " + ++ "depend on the library." + + reloc <- + if not (fromFlag $ configRelocatable cfg) + then return False + else return True + let lbi = LocalBuildInfo { configFlags = cfg, extraConfigArgs = [], -- Currently configure does not @@ -526,30 +647,33 @@ compiler = comp, hostPlatform = compPlatform, buildDir = buildDir', - scratchDir = fromFlagOrDefault - (distPref "scratch") - (configScratchDir cfg), componentsConfigs = buildComponents, installedPkgs = packageDependsIndex, pkgDescrFile = Nothing, localPkgDescr = pkg_descr', + pkgKey = pkg_key, + instantiatedWith = hole_insts, withPrograms = programsConfig''', withVanillaLib = fromFlag $ configVanillaLib cfg, - withProfLib = fromFlag $ configProfLib cfg, - withSharedLib = fromFlagOrDefault sharedLibsByDefault $ - configSharedLib cfg, - withDynExe = fromFlag $ configDynExe cfg, - withProfExe = fromFlag $ configProfExe cfg, + withProfLib = withProfLib_, + withSharedLib = withSharedLib_, + withDynExe = withDynExe_, + withProfExe = withProfExe_, withOptimization = fromFlag $ configOptimization cfg, - withGHCiLib = fromFlag $ configGHCiLib cfg, + withDebugInfo = fromFlag $ configDebugInfo cfg, + withGHCiLib = fromFlagOrDefault ghciLibByDefault $ + configGHCiLib cfg, splitObjs = split_objs, stripExes = fromFlag $ configStripExes cfg, stripLibs = fromFlag $ configStripLibs cfg, withPackageDB = packageDbs, progPrefix = fromFlag $ configProgPrefix cfg, - progSuffix = fromFlag $ configProgSuffix cfg + progSuffix = fromFlag $ configProgSuffix cfg, + relocatable = reloc } + when reloc (checkRelocatable verbosity pkg_descr lbi) + let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest relative = prefixRelativeInstallDirs (packageId pkg_descr) lbi @@ -601,7 +725,7 @@ . setProgramSearchPath searchpath $ initialProgramsConfig searchpath = getProgramSearchPath (initialProgramsConfig) - ++ map ProgramSearchPathDir (configProgramPathExtra cfg) + ++ map ProgramSearchPathDir (fromNubList $ configProgramPathExtra cfg) -- ----------------------------------------------------------------------------- -- Configuring package dependencies @@ -623,14 +747,14 @@ data ResolvedDependency = ExternalDependency Dependency InstalledPackageInfo | InternalDependency Dependency PackageId -- should be a - -- lib name + -- lib name data FailedDependency = DependencyNotExists PackageName | DependencyNoVersion Dependency -- | Test for a package dependency and record the version we have installed. -selectDependency :: PackageIndex -- ^ Internally defined packages - -> PackageIndex -- ^ Installed packages +selectDependency :: InstalledPackageIndex -- ^ Internally defined packages + -> InstalledPackageIndex -- ^ Installed packages -> Map PackageName InstalledPackageInfo -- ^ Packages for which we have been given specific deps to use -> Dependency @@ -692,7 +816,7 @@ getInstalledPackages :: Verbosity -> Compiler -> PackageDBStack -> ProgramConfiguration - -> IO PackageIndex + -> IO InstalledPackageIndex getInstalledPackages verbosity comp packageDBs progconf = do when (null packageDBs) $ die $ "No package databases have been specified. If you use " @@ -701,12 +825,11 @@ info verbosity "Reading installed packages..." case compilerFlavor comp of - GHC -> GHC.getInstalledPackages verbosity packageDBs progconf - Hugs->Hugs.getInstalledPackages verbosity packageDBs progconf - JHC -> JHC.getInstalledPackages verbosity packageDBs progconf - LHC -> LHC.getInstalledPackages verbosity packageDBs progconf - NHC -> NHC.getInstalledPackages verbosity packageDBs progconf - UHC -> UHC.getInstalledPackages verbosity comp packageDBs progconf + GHC -> GHC.getInstalledPackages verbosity packageDBs progconf + GHCJS -> GHCJS.getInstalledPackages verbosity packageDBs progconf + JHC -> JHC.getInstalledPackages verbosity packageDBs progconf + LHC -> LHC.getInstalledPackages verbosity packageDBs progconf + UHC -> UHC.getInstalledPackages verbosity comp packageDBs progconf HaskellSuite {} -> HaskellSuite.getInstalledPackages verbosity packageDBs progconf flv -> die $ "don't know how to find the installed packages for " @@ -715,12 +838,12 @@ -- | Like 'getInstalledPackages', but for a single package DB. getPackageDBContents :: Verbosity -> Compiler -> PackageDB -> ProgramConfiguration - -> IO PackageIndex + -> IO InstalledPackageIndex getPackageDBContents verbosity comp packageDB progconf = do info verbosity "Reading installed packages..." case compilerFlavor comp of GHC -> GHC.getPackageDBContents verbosity packageDB progconf - + GHCJS -> GHCJS.getPackageDBContents verbosity packageDB progconf -- For other compilers, try to fall back on 'getInstalledPackages'. _ -> getInstalledPackages verbosity comp [packageDB] progconf @@ -742,8 +865,7 @@ extra dbs' (Just db:dbs) = extra (dbs' ++ [db]) dbs newPackageDepsBehaviourMinVersion :: Version -newPackageDepsBehaviourMinVersion = Version { versionBranch = [1,7,1], - versionTags = [] } +newPackageDepsBehaviourMinVersion = Version [1,7,1] [] -- In older cabal versions, there was only one set of package dependencies for -- the whole package. In this version, we can have separate dependencies per @@ -766,7 +888,7 @@ -- pick. combinedConstraints :: [Dependency] -> [(PackageName, InstalledPackageId)] -> - PackageIndex -> + InstalledPackageIndex -> Either String ([Dependency], Map PackageName InstalledPackageInfo) combinedConstraints constraints dependencies installedPackages = do @@ -828,6 +950,58 @@ | (pkgname, ipkgid) <- deps ] -- ----------------------------------------------------------------------------- +-- Configuring hole instantiation + +configureInstantiateWith :: PackageDescription + -> ConfigFlags + -> InstalledPackageIndex -- ^ installed packages + -> IO ([InstalledPackageInfo], + [(ModuleName, (InstalledPackageInfo, ModuleName))]) +configureInstantiateWith pkg_descr cfg installedPackageSet = do + -- Holes: First, check and make sure the provided instantiation covers + -- all the holes we know about. Indefinite package installation is + -- not handled at all at this point. + -- NB: We union together /all/ of the requirements when calculating + -- the package key. + -- NB: For now, we assume that dependencies don't contribute signatures. + -- This will be handled by cabal-install; as far as ./Setup is + -- concerned, the most important thing is to be provided correctly + -- built dependencies. + let signatures = + maybe [] (\lib -> requiredSignatures lib ++ exposedSignatures lib) + (PD.library pkg_descr) + signatureSet = Set.fromList signatures + instantiateMap = Map.fromList (configInstantiateWith cfg) + missing_impls = filter (not . flip Map.member instantiateMap) signatures + hole_insts0 = filter (\(k,_) -> Set.member k signatureSet) (configInstantiateWith cfg) + + when (not (null missing_impls)) $ + die $ "Missing signature implementations for these modules: " + ++ intercalate ", " (map display missing_impls) + + -- Holes: Next, we need to make sure we have packages to actually + -- provide the implementations we're talking about. This is on top + -- of the normal dependency resolution process. + -- TODO: internal dependencies (e.g. the test package depending on the + -- main library) is not currently supported + let selectHoleDependency (k,(i,m)) = + case PackageIndex.lookupInstalledPackageId installedPackageSet i of + Just pkginst -> Right (k,(pkginst, m)) + Nothing -> Left i + (failed_hmap, hole_insts) = partitionEithers (map selectHoleDependency hole_insts0) + holeDeps = map (fst.snd) hole_insts -- could have dups + + -- Holes: Finally, any dependencies selected this way have to be + -- included in the allPkgs index, as well as the buildComponents. + -- But don't report these as potential inconsistencies! + + when (not (null failed_hmap)) $ + die $ "Could not resolve these package IDs (from signature implementations): " + ++ intercalate ", " (map display failed_hmap) + + return (holeDeps, hole_insts) + +-- ----------------------------------------------------------------------------- -- Configuring program dependencies configureRequiredPrograms :: Verbosity -> [Dependency] -> ProgramConfiguration @@ -865,9 +1039,12 @@ (lessVerbose verbosity) pkgConfigProgram (orLaterVersion $ Version [0,9,0] []) conf mapM_ requirePkg allpkgs - lib' <- updateLibrary (library pkg_descr) - exes' <- mapM updateExecutable (executables pkg_descr) - let pkg_descr' = pkg_descr { library = lib', executables = exes' } + lib' <- mapM addPkgConfigBILib (library pkg_descr) + exes' <- mapM addPkgConfigBIExe (executables pkg_descr) + tests' <- mapM addPkgConfigBITest (testSuites pkg_descr) + benches' <- mapM addPkgConfigBIBench (benchmarks pkg_descr) + let pkg_descr' = pkg_descr { library = lib', executables = exes', + testSuites = tests', benchmarks = benches' } return (pkg_descr', conf') where @@ -898,15 +1075,27 @@ | isAnyVersion range = "" | otherwise = " version " ++ display range - updateLibrary Nothing = return Nothing - updateLibrary (Just lib) = do - bi <- pkgconfigBuildInfo (pkgconfigDepends (libBuildInfo lib)) - return $ Just lib { libBuildInfo = libBuildInfo lib `mappend` bi } + -- Adds pkgconfig dependencies to the build info for a component + addPkgConfigBI compBI setCompBI comp = do + bi <- pkgconfigBuildInfo (pkgconfigDepends (compBI comp)) + return $ setCompBI comp (compBI comp `mappend` bi) - updateExecutable exe = do - bi <- pkgconfigBuildInfo (pkgconfigDepends (buildInfo exe)) - return exe { buildInfo = buildInfo exe `mappend` bi } + -- Adds pkgconfig dependencies to the build info for a library + addPkgConfigBILib = addPkgConfigBI libBuildInfo $ + \lib bi -> lib { libBuildInfo = bi } + -- Adds pkgconfig dependencies to the build info for an executable + addPkgConfigBIExe = addPkgConfigBI buildInfo $ + \exe bi -> exe { buildInfo = bi } + + -- Adds pkgconfig dependencies to the build info for a test suite + addPkgConfigBITest = addPkgConfigBI testBuildInfo $ + \test bi -> test { testBuildInfo = bi } + + -- Adds pkgconfig dependencies to the build info for a benchmark + addPkgConfigBIBench = addPkgConfigBI benchmarkBuildInfo $ + \bench bi -> bench { benchmarkBuildInfo = bi } + pkgconfigBuildInfo :: [Dependency] -> IO BuildInfo pkgconfigBuildInfo [] = return mempty pkgconfigBuildInfo pkgdeps = do @@ -957,13 +1146,12 @@ configCompilerEx Nothing _ _ _ _ = die "Unknown compiler" configCompilerEx (Just hcFlavor) hcPath hcPkg conf verbosity = do (comp, maybePlatform, programsConfig) <- case hcFlavor of - GHC -> GHC.configure verbosity hcPath hcPkg conf - JHC -> JHC.configure verbosity hcPath hcPkg conf - LHC -> do (_, _, ghcConf) <- GHC.configure verbosity Nothing hcPkg conf - LHC.configure verbosity hcPath Nothing ghcConf - Hugs -> Hugs.configure verbosity hcPath hcPkg conf - NHC -> NHC.configure verbosity hcPath hcPkg conf - UHC -> UHC.configure verbosity hcPath hcPkg conf + GHC -> GHC.configure verbosity hcPath hcPkg conf + GHCJS -> GHCJS.configure verbosity hcPath hcPkg conf + JHC -> JHC.configure verbosity hcPath hcPkg conf + LHC -> do (_, _, ghcConf) <- GHC.configure verbosity Nothing hcPkg conf + LHC.configure verbosity hcPath Nothing ghcConf + UHC -> UHC.configure verbosity hcPath hcPkg conf HaskellSuite {} -> HaskellSuite.configure verbosity hcPath hcPkg conf _ -> die "Unknown compiler" return (comp, fromMaybe buildPlatform maybePlatform, programsConfig) @@ -991,19 +1179,16 @@ -- Making the internal component graph -mkComponentsLocalBuildInfo :: PackageDescription - -> [PackageId] -> [InstalledPackageInfo] - -> Either [ComponentName] - [(ComponentName, - ComponentLocalBuildInfo, [ComponentName])] -mkComponentsLocalBuildInfo pkg_descr internalPkgDeps externalPkgDeps = +mkComponentsGraph :: PackageDescription + -> [PackageId] + -> Either [ComponentName] + [(Component, [ComponentName])] +mkComponentsGraph pkg_descr internalPkgDeps = let graph = [ (c, componentName c, componentDeps c) | c <- pkgEnabledComponents pkg_descr ] in case checkComponentsCyclic graph of Just ccycle -> Left [ cname | (_,cname,_) <- ccycle ] - Nothing -> Right [ (cname, clbi, cdeps) - | (c, cname, cdeps) <- graph - , let clbi = componentLocalBuildInfo c ] + Nothing -> Right [ (c, cdeps) | (c, _, cdeps) <- graph ] where -- The dependencies for the given component componentDeps component = @@ -1017,6 +1202,32 @@ where bi = componentBuildInfo component +reportComponentCycle :: [ComponentName] -> IO a +reportComponentCycle cnames = + die $ "Components in the package depend on each other in a cyclic way:\n " + ++ intercalate " depends on " + [ "'" ++ showComponentName cname ++ "'" + | cname <- cnames ++ [head cnames] ] + +mkComponentsLocalBuildInfo :: InstalledPackageIndex + -> PackageDescription + -> [PackageId] -- internal package deps + -> [InstalledPackageInfo] -- external package deps + -> [InstalledPackageInfo] -- hole package deps + -> Map ModuleName (InstalledPackageInfo, ModuleName) + -> PackageKey + -> [(Component, [ComponentName])] + -> Either [(ModuleReexport, String)] -- errors + [(ComponentName, ComponentLocalBuildInfo, + [ComponentName])] -- ok +mkComponentsLocalBuildInfo installedPackages pkg_descr + internalPkgDeps externalPkgDeps holePkgDeps hole_insts + pkg_key graph = + sequence + [ do clbi <- componentLocalBuildInfo c + return (componentName c, clbi, cdeps) + | (c, cdeps) <- graph ] + where -- The allPkgDeps contains all the package deps for the whole package -- but we need to select the subset for this specific component. -- we just take the subset for the package names this component @@ -1024,48 +1235,197 @@ -- versions of the same package. componentLocalBuildInfo component = case component of - CLib _ -> - LibComponentLocalBuildInfo { + CLib lib -> do + let exports = map (\n -> Installed.ExposedModule n Nothing Nothing) + (PD.exposedModules lib) + esigs = map (\n -> Installed.ExposedModule n Nothing + (fmap (\(pkg,m) -> Installed.OriginalModule + (Installed.installedPackageId pkg) m) + (Map.lookup n hole_insts))) + (PD.exposedSignatures lib) + reexports <- resolveModuleReexports installedPackages + (packageId pkg_descr) + externalPkgDeps lib + return LibComponentLocalBuildInfo { componentPackageDeps = cpds, - componentLibraries = [LibraryName - ("HS" ++ display (package pkg_descr))] + componentLibraries = [LibraryName ("HS" ++ display pkg_key)], + componentPackageRenaming = cprns, + componentExposedModules = exports ++ reexports ++ esigs } CExe _ -> - ExeComponentLocalBuildInfo { - componentPackageDeps = cpds + return ExeComponentLocalBuildInfo { + componentPackageDeps = cpds, + componentPackageRenaming = cprns } CTest _ -> - TestComponentLocalBuildInfo { - componentPackageDeps = cpds + return TestComponentLocalBuildInfo { + componentPackageDeps = cpds, + componentPackageRenaming = cprns } CBench _ -> - BenchComponentLocalBuildInfo { - componentPackageDeps = cpds + return BenchComponentLocalBuildInfo { + componentPackageDeps = cpds, + componentPackageRenaming = cprns } where bi = componentBuildInfo component + dedup = Map.toList . Map.fromList cpds = if newPackageDepsBehaviour pkg_descr - then [ (installedPackageId pkg, packageId pkg) + then dedup $ + [ (Installed.installedPackageId pkg, packageId pkg) | pkg <- selectSubset bi externalPkgDeps ] ++ [ (inplacePackageId pkgid, pkgid) | pkgid <- selectSubset bi internalPkgDeps ] - else [ (installedPackageId pkg, packageId pkg) + ++ [ (Installed.installedPackageId pkg, packageId pkg) + | pkg <- holePkgDeps ] + else [ (Installed.installedPackageId pkg, packageId pkg) | pkg <- externalPkgDeps ] + cprns = if newPackageDepsBehaviour pkg_descr + then Map.unionWith mappend + -- We need hole dependencies passed to GHC, so add them here + -- (but note that they're fully thinned out. If they + -- appeared legitimately the monoid instance will + -- fill them out. + (Map.fromList [(packageName pkg, mempty) | pkg <- holePkgDeps]) + (targetBuildRenaming bi) + -- Hack: if we have old package-deps behavior, it's impossible + -- for non-default renamings to be used, because the Cabal + -- version is too early. This is a good, because while all the + -- 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) selectSubset :: Package pkg => BuildInfo -> [pkg] -> [pkg] selectSubset bi pkgs = - [ pkg | pkg <- pkgs, packageName pkg `elem` names ] - where - names = [ name | Dependency name _ <- targetBuildDepends bi ] + [ pkg | pkg <- pkgs, packageName pkg `elem` names bi ] -reportComponentCycle :: [ComponentName] -> IO a -reportComponentCycle cnames = - die $ "Components in the package depend on each other in a cyclic way:\n " - ++ intercalate " depends on " - [ "'" ++ showComponentName cname ++ "'" - | cname <- cnames ++ [head cnames] ] + names bi = [ name | Dependency name _ <- targetBuildDepends bi ] +-- | Given the author-specified re-export declarations from the .cabal file, +-- resolve them to the form that we need for the package database. +-- +-- An invariant of the package database is that we always link the re-export +-- directly to its original defining location (rather than indirectly via a +-- chain of re-exporting packages). +-- +resolveModuleReexports :: InstalledPackageIndex + -> PackageId + -> [InstalledPackageInfo] + -> Library + -> Either [(ModuleReexport, String)] -- errors + [Installed.ExposedModule] -- ok +resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib = + case partitionEithers (map resolveModuleReexport (PD.reexportedModules lib)) of + ([], ok) -> Right ok + (errs, _) -> Left errs + where + -- A mapping from visible module names to their original defining + -- module name. We also record the package name of the package which + -- *immediately* provided the module (not the original) to handle if the + -- user explicitly says which build-depends they want to reexport from. + visibleModules :: Map ModuleName [(PackageName, Installed.ExposedModule)] + visibleModules = + Map.fromListWith (++) $ + [ (Installed.exposedName exposedModule, [(exportingPackageName, + exposedModule)]) + -- The package index here contains all the indirect deps of the + -- package we're configuring, but we want just the direct deps + | let directDeps = Set.fromList (map Installed.installedPackageId externalPkgDeps) + , pkg <- PackageIndex.allPackages installedPackages + , Installed.installedPackageId pkg `Set.member` directDeps + , let exportingPackageName = packageName pkg + , exposedModule <- visibleModuleDetails pkg + ] + ++ [ (visibleModuleName, [(exportingPackageName, exposedModule)]) + | visibleModuleName <- PD.exposedModules lib + ++ otherModules (libBuildInfo lib) + , let exportingPackageName = packageName srcpkgid + definingModuleName = visibleModuleName + -- we don't know the InstalledPackageId of this package yet + -- we will fill it in later, before registration. + definingPackageId = InstalledPackageId "" + originalModule = Installed.OriginalModule definingPackageId + definingModuleName + exposedModule = Installed.ExposedModule visibleModuleName + (Just originalModule) + Nothing + ] + -- All the modules exported from this package and their defining name and + -- package (either defined here in this package or re-exported from some + -- other package). Return an ExposedModule because we want to hold onto + -- signature information. + visibleModuleDetails :: InstalledPackageInfo -> [Installed.ExposedModule] + visibleModuleDetails pkg = do + exposedModule <- Installed.exposedModules pkg + case Installed.exposedReexport exposedModule of + -- The first case is the modules actually defined in this package. + -- In this case the reexport will point to this package. + Nothing -> return exposedModule { Installed.exposedReexport = + Just (Installed.OriginalModule (Installed.installedPackageId pkg) + (Installed.exposedName exposedModule)) } + -- On the other hand, a visible module might actually be itself + -- a re-export! In this case, the re-export info for the package + -- doing the re-export will point us to the original defining + -- module name and package, so we can reuse the entry. + Just _ -> return exposedModule + + resolveModuleReexport reexport@ModuleReexport { + moduleReexportOriginalPackage = moriginalPackageName, + moduleReexportOriginalName = originalName, + moduleReexportName = newName + } = + + let filterForSpecificPackage = + case moriginalPackageName of + Nothing -> id + Just originalPackageName -> + filter (\(pkgname, _) -> pkgname == originalPackageName) + + matches = filterForSpecificPackage + (Map.findWithDefault [] originalName visibleModules) + in + case (matches, moriginalPackageName) of + ((_, exposedModule):rest, _) + -- TODO: Refine this check for signatures + | all (\(_, exposedModule') -> Installed.exposedReexport exposedModule + == Installed.exposedReexport exposedModule') rest + -> Right exposedModule { Installed.exposedName = newName } + + ([], Just originalPackageName) + -> Left $ (,) reexport + $ "The package " ++ display originalPackageName + ++ " does not export a module " ++ display originalName + + ([], Nothing) + -> Left $ (,) reexport + $ "The module " ++ display originalName + ++ " is not exported by any suitable package (this package " + ++ "itself nor any of its 'build-depends' dependencies)." + + (ms, _) + -> Left $ (,) reexport + $ "The module " ++ display originalName ++ " is exported " + ++ "by more than one package (" + ++ intercalate ", " [ display pkgname | (pkgname,_) <- ms ] + ++ ") and so the re-export is ambiguous. The ambiguity can " + ++ "be resolved by qualifying by the package name. The " + ++ "syntax is 'packagename:moduleName [as newname]'." + + -- Note: if in future Cabal allows directly depending on multiple + -- instances of the same package (e.g. backpack) then an additional + -- ambiguity case is possible here: (_, Just originalPackageName) + -- with the module being ambigious despite being qualified by a + -- package name. Presumably by that time we'll have a mechanism to + -- qualify the instance we're referring to. + +reportModuleReexportProblems :: [(ModuleReexport, String)] -> IO a +reportModuleReexportProblems reexportProblems = + die $ unlines + [ "Problem with the module re-export '" ++ display reexport ++ "': " ++ msg + | (reexport, msg) <- reexportProblems ] + -- ----------------------------------------------------------------------------- -- Testing C lib and header dependencies @@ -1159,11 +1519,20 @@ _ <- rawSystemProgramStdoutConf verbosity gccProgram (withPrograms lbi) (cName:"-o":oNname:args) return True - --TODO: need a better error in the case of not finding gcc! `catchIO` (\_ -> return False) `catchExit` (\_ -> return False) explainErrors Nothing [] = return () -- should be impossible! + explainErrors _ _ + | isNothing . lookupProgram gccProgram . withPrograms $ lbi + + = die $ unlines $ + [ "No working gcc", + "This package depends on foreign library but we cannot " + ++ "find a working C compiler. If you have it in a " + ++ "non-standard location you can use the --with-gcc " + ++ "flag to specify it." ] + explainErrors hdr libs = die $ unlines $ [ if plural then "Missing dependencies on foreign libraries:" @@ -1227,3 +1596,69 @@ if null errors then mapM_ (warn verbosity) warnings else die (intercalate "\n\n" errors) + +-- | Preform checks if a relocatable build is allowed +checkRelocatable :: Verbosity + -> PackageDescription + -> LocalBuildInfo + -> IO () +checkRelocatable verbosity pkg lbi + = sequence_ [ checkOS + , checkCompiler + , packagePrefixRelative + , depsPrefixRelative + ] + where + -- Check if the OS support relocatable builds. + -- + -- If you add new OS' to this list, and your OS supports dynamic libraries + -- and RPATH, make sure you add your OS to RPATH-support list of: + -- Distribution.Simple.GHC.getRPaths + checkOS + = unless (os `elem` [ OSX, Linux ]) + $ die $ "Operating system: " ++ display os ++ + ", does not support relocatable builds" + where + (Platform _ os) = hostPlatform lbi + + -- Check if the Compiler support relocatable builds + checkCompiler + = unless (compilerFlavor comp `elem` [ GHC ]) + $ die $ "Compiler: " ++ show comp ++ + ", does not support relocatable builds" + where + comp = compiler lbi + + -- Check if all the install dirs are relative to same prefix + packagePrefixRelative + = unless (relativeInstallDirs installDirs) + $ die $ "Installation directories are not prefix_relative:\n" ++ + show installDirs + where + installDirs = absoluteInstallDirs pkg lbi NoCopyDest + p = prefix installDirs + relativeInstallDirs (InstallDirs {..}) = + all isJust + (fmap (stripPrefix p) + [ bindir, libdir, dynlibdir, libexecdir, includedir, datadir + , docdir, mandir, htmldir, haddockdir, sysconfdir] ) + + -- Check if the library dirs of the dependencies that are in the package + -- database to which the package is installed are relative to the + -- prefix of the package + depsPrefixRelative = do + pkgr <- GHC.pkgRoot verbosity lbi (last (withPackageDB lbi)) + mapM_ (doCheck pkgr) ipkgs + where + doCheck pkgr ipkg + | maybe False (== pkgr) (Installed.pkgRoot ipkg) + = mapM_ (\l -> when (isNothing $ stripPrefix p l) (die (msg l))) + (Installed.libraryDirs ipkg) + | otherwise + = return () + installDirs = absoluteInstallDirs pkg lbi NoCopyDest + p = prefix installDirs + ipkgs = PackageIndex.allPackages (installedPkgs lbi) + msg l = "Library directory of a dependency: " ++ show l ++ + "\nis not relative to the installation prefix:\n" ++ + show p diff --git a/Distribution/Simple/GHC.hs b/Distribution/Simple/GHC.hs --- a/Distribution/Simple/GHC.hs +++ b/Distribution/Simple/GHC.hs @@ -38,1316 +38,1049 @@ startInterpreter, installLib, installExe, libAbiHash, - initPackageDB, - invokeHcPkg, - registerPackage, - componentGhcOptions, - ghcLibDir, - ghcDynamic, - ghcGlobalPackageDB, - ) where - -import qualified Distribution.Simple.GHC.IPI641 as IPI641 -import qualified Distribution.Simple.GHC.IPI642 as IPI642 -import Distribution.PackageDescription as PD - ( PackageDescription(..), BuildInfo(..), Executable(..) - , Library(..), libModules, exeModules, hcOptions - , usedExtensions, allExtensions ) -import Distribution.InstalledPackageInfo - ( InstalledPackageInfo ) -import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo - ( InstalledPackageInfo_(..) ) -import Distribution.Simple.PackageIndex (PackageIndex) -import qualified Distribution.Simple.PackageIndex as PackageIndex -import Distribution.Simple.LocalBuildInfo - ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) - , LibraryName(..), absoluteInstallDirs ) -import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs ) -import Distribution.Simple.BuildPaths -import Distribution.Simple.Utils -import Distribution.Package - ( Package(..), PackageName(..) ) -import qualified Distribution.ModuleName as ModuleName -import Distribution.Simple.Program - ( Program(..), ConfiguredProgram(..), ProgramConfiguration - , ProgramLocation(..), ProgramSearchPath, ProgramSearchPathEntry(..) - , rawSystemProgram - , rawSystemProgramStdout, rawSystemProgramStdoutConf - , getProgramOutput, getProgramInvocationOutput, suppressOverrideArgs - , requireProgramVersion, requireProgram - , userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram - , ghcProgram, ghcPkgProgram, hsc2hsProgram - , arProgram, ldProgram - , gccProgram, stripProgram ) -import qualified Distribution.Simple.Program.HcPkg as HcPkg -import qualified Distribution.Simple.Program.Ar as Ar -import qualified Distribution.Simple.Program.Ld as Ld -import qualified Distribution.Simple.Program.Strip as Strip -import Distribution.Simple.Program.GHC -import Distribution.Simple.Setup - ( toFlag, fromFlag, fromFlagOrDefault ) -import qualified Distribution.Simple.Setup as Cabal - ( Flag ) -import Distribution.Simple.Compiler - ( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion - , OptimisationLevel(..), PackageDB(..), PackageDBStack - , Flag ) -import Distribution.Version - ( Version(..), anyVersion, orLaterVersion ) -import Distribution.System - ( Platform(..), OS(..), buildOS, platformFromTriple ) -import Distribution.Verbosity -import Distribution.Text - ( display, simpleParse ) -import Language.Haskell.Extension (Language(..), Extension(..) - ,KnownExtension(..)) - -import Control.Monad ( unless, when ) -import Data.Char ( isSpace ) -import Data.List -import qualified Data.Map as M ( Map, fromList, lookup ) -import Data.Maybe ( catMaybes, fromMaybe, maybeToList ) -import Data.Monoid ( Monoid(..) ) -import System.Directory - ( getDirectoryContents, doesFileExist, getTemporaryDirectory ) -import System.FilePath ( (), (<.>), takeExtension, - takeDirectory, replaceExtension, - splitExtension ) -import System.IO (hClose, hPutStrLn) -import System.Environment (getEnv) -import Distribution.Compat.Exception (catchExit, catchIO) - - --- ----------------------------------------------------------------------------- --- Configuring - -configure :: Verbosity -> Maybe FilePath -> Maybe FilePath - -> ProgramConfiguration - -> IO (Compiler, Maybe Platform, ProgramConfiguration) -configure verbosity hcPath hcPkgPath conf0 = do - - (ghcProg, ghcVersion, conf1) <- - requireProgramVersion verbosity ghcProgram - (orLaterVersion (Version [6,4] [])) - (userMaybeSpecifyPath "ghc" hcPath conf0) - - -- 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, conf2) <- - requireProgramVersion verbosity ghcPkgProgram { - programFindLocation = guessGhcPkgFromGhcPath ghcProg - } - anyVersion (userMaybeSpecifyPath "ghc-pkg" hcPkgPath conf1) - - when (ghcVersion /= ghcPkgVersion) $ die $ - "Version mismatch between ghc and ghc-pkg: " - ++ programPath ghcProg ++ " is version " ++ display ghcVersion ++ " " - ++ programPath ghcPkgProg ++ " is version " ++ display ghcPkgVersion - - -- Likewise we try to find the matching hsc2hs program. - let hsc2hsProgram' = hsc2hsProgram { - programFindLocation = guessHsc2hsFromGhcPath ghcProg - } - conf3 = addKnownProgram hsc2hsProgram' conf2 - - languages <- getLanguages verbosity ghcProg - extensions <- getExtensions verbosity ghcProg - - ghcInfo <- getGhcInfo verbosity ghcProg - let ghcInfoMap = M.fromList ghcInfo - - let comp = Compiler { - compilerId = CompilerId GHC ghcVersion, - compilerLanguages = languages, - compilerExtensions = extensions, - compilerProperties = ghcInfoMap - } - compPlatform = targetPlatform ghcInfo - conf4 = configureToolchain ghcProg ghcInfoMap conf3 -- configure gcc and ld - return (comp, compPlatform, conf4) - -targetPlatform :: [(String, String)] -> Maybe Platform -targetPlatform ghcInfo = platformFromTriple =<< lookup "Target platform" ghcInfo - --- | 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: --- --- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe) --- > /usr/local/bin/ghc-pkg-6.6.1(.exe) --- > /usr/local/bin/ghc-pkg(.exe) --- -guessToolFromGhcPath :: Program -> ConfiguredProgram - -> Verbosity -> ProgramSearchPath - -> IO (Maybe FilePath) -guessToolFromGhcPath tool ghcProg verbosity searchpath - = do let toolname = programName tool - path = programPath ghcProg - dir = takeDirectory path - versionSuffix = takeVersionSuffix (dropExeExtension path) - guessNormal = dir toolname <.> exeExtension - guessGhcVersioned = dir (toolname ++ "-ghc" ++ versionSuffix) - <.> exeExtension - guessVersioned = dir (toolname ++ versionSuffix) - <.> exeExtension - guesses | null versionSuffix = [guessNormal] - | otherwise = [guessGhcVersioned, - guessVersioned, - guessNormal] - info verbosity $ "looking for tool " ++ toolname - ++ " near compiler in " ++ dir - exists <- mapM doesFileExist guesses - case [ file | (file, True) <- zip guesses exists ] of - -- If we can't find it near ghc, fall back to the usual - -- method. - [] -> programFindLocation tool verbosity searchpath - (fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp - return (Just fp) - - where takeVersionSuffix :: FilePath -> String - takeVersionSuffix = reverse . takeWhile (`elem ` "0123456789.-") . - reverse - - dropExeExtension :: FilePath -> FilePath - dropExeExtension filepath = - case splitExtension filepath of - (filepath', extension) | extension == exeExtension -> filepath' - | otherwise -> filepath - --- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a --- corresponding ghc-pkg, we try looking for both a versioned and unversioned --- ghc-pkg in the same dir, that is: --- --- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe) --- > /usr/local/bin/ghc-pkg-6.6.1(.exe) --- > /usr/local/bin/ghc-pkg(.exe) --- -guessGhcPkgFromGhcPath :: ConfiguredProgram - -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath) -guessGhcPkgFromGhcPath = guessToolFromGhcPath ghcPkgProgram - --- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a --- corresponding hsc2hs, we try looking for both a versioned and unversioned --- hsc2hs in the same dir, that is: --- --- > /usr/local/bin/hsc2hs-ghc-6.6.1(.exe) --- > /usr/local/bin/hsc2hs-6.6.1(.exe) --- > /usr/local/bin/hsc2hs(.exe) --- -guessHsc2hsFromGhcPath :: ConfiguredProgram - -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath) -guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram - --- | Adjust the way we find and configure gcc and ld --- -configureToolchain :: ConfiguredProgram -> M.Map String String - -> ProgramConfiguration - -> ProgramConfiguration -configureToolchain ghcProg ghcInfo = - addKnownProgram gccProgram { - programFindLocation = findProg gccProgram extraGccPath, - programPostConf = configureGcc - } - . addKnownProgram ldProgram { - programFindLocation = findProg ldProgram extraLdPath, - programPostConf = configureLd - } - . addKnownProgram arProgram { - programFindLocation = findProg arProgram extraArPath - } - . addKnownProgram stripProgram { - programFindLocation = findProg stripProgram extraStripPath - } - where - Just ghcVersion = programVersion ghcProg - compilerDir = takeDirectory (programPath ghcProg) - baseDir = takeDirectory compilerDir - mingwBinDir = baseDir "mingw" "bin" - libDir = baseDir "gcc-lib" - includeDir = baseDir "include" "mingw" - isWindows = case buildOS of Windows -> True; _ -> False - binPrefix = "" - - mkExtraPath :: Maybe FilePath -> FilePath -> [FilePath] - mkExtraPath mbPath mingwPath | isWindows = mbDir ++ [mingwPath] - | otherwise = mbDir - where - mbDir = maybeToList . fmap takeDirectory $ mbPath - - extraGccPath = mkExtraPath mbGccLocation windowsExtraGccDir - 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 - | ghcVersion >= Version [6,12] [] = mingwBinDir binPrefix - | otherwise = baseDir - windowsExtraLdDir - | ghcVersion >= Version [6,12] [] = mingwBinDir binPrefix - | otherwise = libDir - windowsExtraArDir - | ghcVersion >= Version [6,12] [] = mingwBinDir binPrefix - | otherwise = libDir - windowsExtraStripDir - | ghcVersion >= Version [6,12] [] = mingwBinDir binPrefix - | otherwise = libDir - - findProg :: Program -> [FilePath] - -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath) - findProg prog extraPath v searchpath = - programFindLocation prog v searchpath' - where - searchpath' = (map ProgramSearchPathDir extraPath) ++ searchpath - - -- Read tool locations from the 'ghc --info' output. Useful when - -- cross-compiling. - mbGccLocation = M.lookup "C compiler command" ghcInfo - mbLdLocation = M.lookup "ld command" ghcInfo - mbArLocation = M.lookup "ar command" ghcInfo - mbStripLocation = M.lookup "strip command" ghcInfo - - ccFlags = getFlags "C compiler flags" - gccLinkerFlags = getFlags "Gcc Linker flags" - ldLinkerFlags = getFlags "Ld Linker flags" - - getFlags key = case M.lookup key ghcInfo of - Nothing -> [] - Just flags -> - case reads flags of - [(args, "")] -> args - _ -> [] -- XXX Should should be an error really - - configureGcc :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram - configureGcc v gccProg = do - gccProg' <- configureGcc' v gccProg - return gccProg' { - programDefaultArgs = programDefaultArgs gccProg' - ++ ccFlags ++ gccLinkerFlags - } - - configureGcc' :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram - configureGcc' - | isWindows = \_ gccProg -> case programLocation gccProg of - -- if it's found on system then it means we're using the result - -- of programFindLocation above rather than a user-supplied path - -- Pre GHC 6.12, that meant we should add these flags to tell - -- ghc's gcc where it lives and thus where gcc can find its - -- various files: - FoundOnSystem {} - | ghcVersion < Version [6,11] [] -> - return gccProg { programDefaultArgs = ["-B" ++ libDir, - "-I" ++ includeDir] } - _ -> return gccProg - | otherwise = \_ gccProg -> return gccProg - - configureLd :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram - configureLd v ldProg = do - ldProg' <- configureLd' v ldProg - return ldProg' { - programDefaultArgs = programDefaultArgs ldProg' ++ ldLinkerFlags - } - - -- 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 - hPutStrLn testchnd "int foo() { return 0; }" - hClose testchnd; hClose testohnd - rawSystemProgram verbosity ghcProg ["-c", testcfile, - "-o", testofile] - withTempFile tempDir ".o" $ \testofile' testohnd' -> - do - hClose testohnd' - _ <- rawSystemProgramStdout verbosity ldProg - ["-x", "-r", testofile, "-o", testofile'] - return True - `catchIO` (\_ -> return False) - `catchExit` (\_ -> return False) - if ldx - then return ldProg { programDefaultArgs = ["-x"] } - else return ldProg - -getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, Flag)] -getLanguages _ ghcProg - -- TODO: should be using --supported-languages rather than hard coding - | ghcVersion >= Version [7] [] = return [(Haskell98, "-XHaskell98") - ,(Haskell2010, "-XHaskell2010")] - | otherwise = return [(Haskell98, "")] - where - Just ghcVersion = programVersion ghcProg - -getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)] -getGhcInfo verbosity ghcProg = - case programVersion ghcProg of - Just ghcVersion - | ghcVersion >= Version [6,7] [] -> - do xs <- getProgramOutput verbosity (suppressOverrideArgs ghcProg) - ["--info"] - case reads xs of - [(i, ss)] - | all isSpace ss -> - return i - _ -> - die "Can't parse --info output of GHC" - _ -> - return [] - -getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Flag)] -getExtensions verbosity ghcProg - | ghcVersion >= Version [6,7] [] = do - - str <- getProgramOutput verbosity (suppressOverrideArgs ghcProg) - ["--supported-languages"] - let extStrs = if ghcVersion >= Version [7] [] - then lines str - else -- Older GHCs only gave us either Foo or NoFoo, - -- so we have to work out the other one ourselves - [ extStr'' - | extStr <- lines str - , let extStr' = case extStr of - 'N' : 'o' : xs -> xs - _ -> "No" ++ extStr - , extStr'' <- [extStr, extStr'] - ] - let extensions0 = [ (ext, "-X" ++ display ext) - | Just ext <- map simpleParse extStrs ] - extensions1 = if ghcVersion >= Version [6,8] [] && - ghcVersion < Version [6,10] [] - then -- ghc-6.8 introduced RecordPuns however it - -- should have been NamedFieldPuns. We now - -- encourage packages to use NamedFieldPuns - -- so for compatibility we fake support for - -- it in ghc-6.8 by making it an alias for - -- the old RecordPuns extension. - (EnableExtension NamedFieldPuns, "-XRecordPuns") : - (DisableExtension NamedFieldPuns, "-XNoRecordPuns") : - extensions0 - else extensions0 - extensions2 = if ghcVersion < Version [7,1] [] - then -- ghc-7.2 split NondecreasingIndentation off - -- into a proper extension. Before that it - -- was always on. - (EnableExtension NondecreasingIndentation, "") : - (DisableExtension NondecreasingIndentation, "") : - extensions1 - else extensions1 - return extensions2 - - | otherwise = return oldLanguageExtensions - - where - Just ghcVersion = programVersion ghcProg - --- | For GHC 6.6.x and earlier, the mapping from supported extensions to flags -oldLanguageExtensions :: [(Extension, Flag)] -oldLanguageExtensions = - let doFlag (f, (enable, disable)) = [(EnableExtension f, enable), - (DisableExtension f, disable)] - fglasgowExts = ("-fglasgow-exts", - "") -- This is wrong, but we don't want to turn - -- all the extensions off when asked to just - -- turn one off - fFlag flag = ("-f" ++ flag, "-fno-" ++ flag) - in concatMap doFlag - [(OverlappingInstances , fFlag "allow-overlapping-instances") - ,(TypeSynonymInstances , fglasgowExts) - ,(TemplateHaskell , fFlag "th") - ,(ForeignFunctionInterface , fFlag "ffi") - ,(MonomorphismRestriction , fFlag "monomorphism-restriction") - ,(MonoPatBinds , fFlag "mono-pat-binds") - ,(UndecidableInstances , fFlag "allow-undecidable-instances") - ,(IncoherentInstances , fFlag "allow-incoherent-instances") - ,(Arrows , fFlag "arrows") - ,(Generics , fFlag "generics") - ,(ImplicitPrelude , fFlag "implicit-prelude") - ,(ImplicitParams , fFlag "implicit-params") - ,(CPP , ("-cpp", ""{- Wrong -})) - ,(BangPatterns , fFlag "bang-patterns") - ,(KindSignatures , fglasgowExts) - ,(RecursiveDo , fglasgowExts) - ,(ParallelListComp , fglasgowExts) - ,(MultiParamTypeClasses , fglasgowExts) - ,(FunctionalDependencies , fglasgowExts) - ,(Rank2Types , fglasgowExts) - ,(RankNTypes , fglasgowExts) - ,(PolymorphicComponents , fglasgowExts) - ,(ExistentialQuantification , fglasgowExts) - ,(ScopedTypeVariables , fFlag "scoped-type-variables") - ,(FlexibleContexts , fglasgowExts) - ,(FlexibleInstances , fglasgowExts) - ,(EmptyDataDecls , fglasgowExts) - ,(PatternGuards , fglasgowExts) - ,(GeneralizedNewtypeDeriving , fglasgowExts) - ,(MagicHash , fglasgowExts) - ,(UnicodeSyntax , fglasgowExts) - ,(PatternSignatures , fglasgowExts) - ,(UnliftedFFITypes , fglasgowExts) - ,(LiberalTypeSynonyms , fglasgowExts) - ,(TypeOperators , fglasgowExts) - ,(GADTs , fglasgowExts) - ,(RelaxedPolyRec , fglasgowExts) - ,(ExtendedDefaultRules , fFlag "extended-default-rules") - ,(UnboxedTuples , fglasgowExts) - ,(DeriveDataTypeable , fglasgowExts) - ,(ConstrainedClassMethods , fglasgowExts) - ] --- | Given a single package DB, return all installed packages. -getPackageDBContents :: Verbosity -> PackageDB -> ProgramConfiguration - -> IO PackageIndex -getPackageDBContents verbosity packagedb conf = do - pkgss <- getInstalledPackages' verbosity [packagedb] conf - toPackageIndex verbosity pkgss conf - --- | Given a package DB stack, return all installed packages. -getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration - -> IO PackageIndex -getInstalledPackages verbosity packagedbs conf = do - checkPackageDbEnvVar - checkPackageDbStack packagedbs - pkgss <- getInstalledPackages' verbosity packagedbs conf - index <- toPackageIndex verbosity pkgss conf - return $! hackRtsPackage index - - where - hackRtsPackage index = - case PackageIndex.lookupPackageName index (PackageName "rts") of - [(_,[rts])] - -> PackageIndex.insert (removeMingwIncludeDir rts) index - _ -> index -- No (or multiple) ghc rts package is registered!! - -- Feh, whatever, the ghc test suite does some crazy stuff. - --- | Given a list of @(PackageDB, InstalledPackageInfo)@ pairs, produce a --- @PackageIndex@. Helper function used by 'getPackageDBContents' and --- 'getInstalledPackages'. -toPackageIndex :: Verbosity - -> [(PackageDB, [InstalledPackageInfo])] - -> ProgramConfiguration - -> IO PackageIndex -toPackageIndex verbosity pkgss conf = do - -- On Windows, various fields have $topdir/foo rather than full - -- paths. We need to substitute the right value in so that when - -- we, for example, call gcc, we have proper paths to give it. - topDir <- ghcLibDir' verbosity ghcProg - let indices = [ PackageIndex.fromList (map (substTopDir topDir) pkgs) - | (_, pkgs) <- pkgss ] - return $! (mconcat indices) - - where - Just ghcProg = lookupProgram ghcProgram conf - -ghcLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath -ghcLibDir verbosity lbi = - (reverse . dropWhile isSpace . reverse) `fmap` - rawSystemProgramStdoutConf verbosity ghcProgram - (withPrograms lbi) ["--print-libdir"] - -ghcLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath -ghcLibDir' verbosity ghcProg = - (reverse . dropWhile isSpace . reverse) `fmap` - rawSystemProgramStdout verbosity ghcProg ["--print-libdir"] - - --- | Return the 'FilePath' to the global GHC package database. -ghcGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath -ghcGlobalPackageDB verbosity ghcProg = - (reverse . dropWhile isSpace . reverse) `fmap` - rawSystemProgramStdout verbosity ghcProg ["--print-global-package-db"] - --- Cabal does not use the environment variable GHC_PACKAGE_PATH; let users --- know that this is the case. See ticket #335. Simply ignoring it is not a --- good idea, since then ghc and cabal are looking at different sets of --- package DBs and chaos is likely to ensue. -checkPackageDbEnvVar :: IO () -checkPackageDbEnvVar = do - hasGPP <- (getEnv "GHC_PACKAGE_PATH" >> return True) - `catchIO` (\_ -> return False) - when hasGPP $ - die $ "Use of GHC's environment variable GHC_PACKAGE_PATH is " - ++ "incompatible with Cabal. Use the flag --package-db to specify a " - ++ "package database (it can be used multiple times)." - -checkPackageDbStack :: PackageDBStack -> IO () -checkPackageDbStack (GlobalPackageDB:rest) - | GlobalPackageDB `notElem` rest = return () -checkPackageDbStack rest - | GlobalPackageDB `notElem` rest = - die $ "With current ghc versions the global package db is always used " - ++ "and must be listed first. This ghc limitation may be lifted in " - ++ "future, see http://hackage.haskell.org/trac/ghc/ticket/5977" -checkPackageDbStack _ = - die $ "If the global package db is specified, it must be " - ++ "specified first and cannot be specified multiple times" - --- GHC < 6.10 put "$topdir/include/mingw" in rts's installDirs. This --- breaks when you want to use a different gcc, so we need to filter --- it out. -removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo -removeMingwIncludeDir pkg = - let ids = InstalledPackageInfo.includeDirs pkg - ids' = filter (not . ("mingw" `isSuffixOf`)) ids - in pkg { InstalledPackageInfo.includeDirs = ids' } - --- | Get the packages from specific PackageDBs, not cumulative. --- -getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramConfiguration - -> IO [(PackageDB, [InstalledPackageInfo])] -getInstalledPackages' verbosity packagedbs conf - | ghcVersion >= Version [6,9] [] = - sequence - [ do pkgs <- HcPkg.dump verbosity ghcPkgProg packagedb - return (packagedb, pkgs) - | packagedb <- packagedbs ] - - where - Just ghcPkgProg = lookupProgram ghcPkgProgram conf - Just ghcProg = lookupProgram ghcProgram conf - Just ghcVersion = programVersion ghcProg - -getInstalledPackages' verbosity packagedbs conf = do - str <- rawSystemProgramStdoutConf verbosity ghcPkgProgram conf ["list"] - let pkgFiles = [ init line | line <- lines str, last line == ':' ] - dbFile packagedb = case (packagedb, pkgFiles) of - (GlobalPackageDB, global:_) -> return $ Just global - (UserPackageDB, _global:user:_) -> return $ Just user - (UserPackageDB, _global:_) -> return $ Nothing - (SpecificPackageDB specific, _) -> return $ Just specific - _ -> die "cannot read ghc-pkg package listing" - pkgFiles' <- mapM dbFile packagedbs - sequence [ withFileContents file $ \content -> do - pkgs <- readPackages file content - return (db, pkgs) - | (db , Just file) <- zip packagedbs pkgFiles' ] - where - -- Depending on the version of ghc we use a different type's Read - -- instance to parse the package file and then convert. - -- It's a bit yuck. But that's what we get for using Read/Show. - readPackages - | ghcVersion >= Version [6,4,2] [] - = \file content -> case reads content of - [(pkgs, _)] -> return (map IPI642.toCurrent pkgs) - _ -> failToRead file - | otherwise - = \file content -> case reads content of - [(pkgs, _)] -> return (map IPI641.toCurrent pkgs) - _ -> failToRead file - Just ghcProg = lookupProgram ghcProgram conf - Just ghcVersion = programVersion ghcProg - failToRead file = die $ "cannot read ghc package database " ++ file - -substTopDir :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo -substTopDir topDir ipo - = ipo { - InstalledPackageInfo.importDirs - = map f (InstalledPackageInfo.importDirs ipo), - InstalledPackageInfo.libraryDirs - = map f (InstalledPackageInfo.libraryDirs ipo), - InstalledPackageInfo.includeDirs - = map f (InstalledPackageInfo.includeDirs ipo), - InstalledPackageInfo.frameworkDirs - = map f (InstalledPackageInfo.frameworkDirs ipo), - InstalledPackageInfo.haddockInterfaces - = map f (InstalledPackageInfo.haddockInterfaces ipo), - InstalledPackageInfo.haddockHTMLs - = map f (InstalledPackageInfo.haddockHTMLs ipo) - } - where f ('$':'t':'o':'p':'d':'i':'r':rest) = topDir ++ rest - f x = x - --- ----------------------------------------------------------------------------- --- Building - --- | Build a library with GHC. --- -buildLib, replLib :: Verbosity -> Cabal.Flag (Maybe Int) - -> PackageDescription -> LocalBuildInfo - -> Library -> ComponentLocalBuildInfo -> IO () -buildLib = buildOrReplLib False -replLib = buildOrReplLib True - -buildOrReplLib :: Bool -> Verbosity -> Cabal.Flag (Maybe Int) - -> PackageDescription -> LocalBuildInfo - -> Library -> ComponentLocalBuildInfo -> IO () -buildOrReplLib forRepl verbosity numJobsFlag pkg_descr lbi lib clbi = do - libName <- case componentLibraries clbi of - [libName] -> return libName - [] -> die "No library name found when building library" - _ -> die "Multiple library names found when building library" - - let libTargetDir = buildDir lbi - numJobs = fromMaybe 1 $ fromFlagOrDefault Nothing numJobsFlag - pkgid = packageId pkg_descr - whenVanillaLib forceVanilla = - when (not forRepl && (forceVanilla || withVanillaLib lbi)) - whenProfLib = when (not forRepl && withProfLib lbi) - whenSharedLib forceShared = - when (not forRepl && (forceShared || withSharedLib lbi)) - whenGHCiLib = when (not forRepl && withGHCiLib lbi && withVanillaLib lbi) - ifReplLib = when forRepl - comp = compiler lbi - ghcVersion = compilerVersion comp - (Platform _hostArch hostOS) = hostPlatform lbi - - (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) - let runGhcProg = runGHC verbosity ghcProg comp - - libBi <- hackThreadedFlag verbosity - comp (withProfLib lbi) (libBuildInfo lib) - - let isGhcDynamic = ghcDynamic comp - dynamicTooSupported = ghcSupportsDynamicToo comp - doingTH = EnableExtension TemplateHaskell `elem` allExtensions libBi - forceVanillaLib = doingTH && not isGhcDynamic - forceSharedLib = doingTH && isGhcDynamic - -- TH always needs default libs, even when building for profiling - - createDirectoryIfMissingVerbose verbosity True libTargetDir - -- TODO: do we need to put hs-boot files into place for mutually recursive - -- modules? - let cObjs = map (`replaceExtension` objExtension) (cSources libBi) - baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir - vanillaOpts = baseOpts `mappend` mempty { - ghcOptMode = toFlag GhcModeMake, - ghcOptNumJobs = toFlag numJobs, - ghcOptPackageName = toFlag pkgid, - ghcOptInputModules = libModules lib - } - - profOpts = vanillaOpts `mappend` mempty { - ghcOptProfilingMode = toFlag True, - ghcOptHiSuffix = toFlag "p_hi", - ghcOptObjSuffix = toFlag "p_o", - ghcOptExtra = ghcProfOptions libBi - } - - sharedOpts = vanillaOpts `mappend` mempty { - ghcOptDynLinkMode = toFlag GhcDynamicOnly, - ghcOptFPic = toFlag True, - ghcOptHiSuffix = toFlag "dyn_hi", - ghcOptObjSuffix = toFlag "dyn_o", - ghcOptExtra = ghcSharedOptions libBi - } - linkerOpts = mempty { - ghcOptLinkOptions = PD.ldOptions libBi, - ghcOptLinkLibs = extraLibs libBi, - ghcOptLinkLibPath = extraLibDirs libBi, - ghcOptLinkFrameworks = PD.frameworks libBi, - ghcOptInputFiles = [libTargetDir x | x <- cObjs] - } - replOpts = vanillaOpts { - ghcOptExtra = filterGhciFlags - (ghcOptExtra vanillaOpts), - ghcOptNumJobs = mempty - } - `mappend` linkerOpts - `mappend` mempty { - ghcOptMode = toFlag GhcModeInteractive, - ghcOptOptimisation = toFlag GhcNoOptimisation - } - - vanillaSharedOpts = vanillaOpts `mappend` mempty { - ghcOptDynLinkMode = toFlag GhcStaticAndDynamic, - ghcOptDynHiSuffix = toFlag "dyn_hi", - ghcOptDynObjSuffix = toFlag "dyn_o" - } - - unless (null (libModules lib)) $ - do let vanilla = whenVanillaLib forceVanillaLib (runGhcProg vanillaOpts) - shared = whenSharedLib forceSharedLib (runGhcProg sharedOpts) - useDynToo = dynamicTooSupported && - (forceVanillaLib || withVanillaLib lbi) && - (forceSharedLib || withSharedLib lbi) && - null (ghcSharedOptions libBi) - if useDynToo - then runGhcProg vanillaSharedOpts - else if isGhcDynamic then do shared; vanilla - else do vanilla; shared - whenProfLib (runGhcProg profOpts) - - -- build any C sources - unless (null (cSources libBi)) $ do - info verbosity "Building C Sources..." - sequence_ - [ do let baseCcOpts = componentCcGhcOptions verbosity lbi - libBi clbi libTargetDir filename - vanillaCcOpts = if isGhcDynamic - -- Dynamic GHC requires C sources to be built - -- with -fPIC for REPL to work. See #2207. - then baseCcOpts { ghcOptFPic = toFlag True } - else baseCcOpts - profCcOpts = vanillaCcOpts `mappend` mempty { - ghcOptProfilingMode = toFlag True, - ghcOptObjSuffix = toFlag "p_o" - } - sharedCcOpts = vanillaCcOpts `mappend` mempty { - ghcOptFPic = toFlag True, - ghcOptDynLinkMode = toFlag GhcDynamicOnly, - ghcOptObjSuffix = toFlag "dyn_o" - } - odir = fromFlag (ghcOptObjDir vanillaCcOpts) - createDirectoryIfMissingVerbose verbosity True odir - runGhcProg vanillaCcOpts - whenSharedLib forceSharedLib (runGhcProg sharedCcOpts) - whenProfLib (runGhcProg profCcOpts) - | filename <- cSources libBi] - - -- TODO: problem here is we need the .c files built first, so we can load them - -- with ghci, but .c files can depend on .h files generated by ghc by ffi - -- exports. - unless (null (libModules lib)) $ - ifReplLib (runGhcProg replOpts) - - - -- link: - info verbosity "Linking..." - let cProfObjs = map (`replaceExtension` ("p_" ++ objExtension)) - (cSources libBi) - cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension)) - (cSources libBi) - cid = compilerId (compiler lbi) - vanillaLibFilePath = libTargetDir mkLibName libName - profileLibFilePath = libTargetDir mkProfLibName libName - sharedLibFilePath = libTargetDir mkSharedLibName cid libName - ghciLibFilePath = libTargetDir mkGHCiLibName libName - libInstallPath = libdir $ absoluteInstallDirs pkg_descr lbi NoCopyDest - sharedLibInstallPath = libInstallPath mkSharedLibName cid libName - - stubObjs <- fmap catMaybes $ sequence - [ findFileWithExtension [objExtension] [libTargetDir] - (ModuleName.toFilePath x ++"_stub") - | ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files - , x <- libModules lib ] - stubProfObjs <- fmap catMaybes $ sequence - [ findFileWithExtension ["p_" ++ objExtension] [libTargetDir] - (ModuleName.toFilePath x ++"_stub") - | ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files - , x <- libModules lib ] - stubSharedObjs <- fmap catMaybes $ sequence - [ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir] - (ModuleName.toFilePath x ++"_stub") - | ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files - , x <- libModules lib ] - - hObjs <- getHaskellObjects lib lbi - libTargetDir objExtension True - hProfObjs <- - if (withProfLib lbi) - then getHaskellObjects lib lbi - libTargetDir ("p_" ++ objExtension) True - else return [] - hSharedObjs <- - if (withSharedLib lbi) - then getHaskellObjects lib lbi - libTargetDir ("dyn_" ++ objExtension) False - else return [] - - unless (null hObjs && null cObjs && null stubObjs) $ do - - let staticObjectFiles = - hObjs - ++ map (libTargetDir ) cObjs - ++ stubObjs - profObjectFiles = - hProfObjs - ++ map (libTargetDir ) cProfObjs - ++ stubProfObjs - ghciObjFiles = - hObjs - ++ map (libTargetDir ) cObjs - ++ stubObjs - dynamicObjectFiles = - hSharedObjs - ++ map (libTargetDir ) cSharedObjs - ++ stubSharedObjs - -- After the relocation lib is created we invoke ghc -shared - -- with the dependencies spelled out as -package arguments - -- and ghc invokes the linker with the proper library paths - ghcSharedLinkArgs = - mempty { - ghcOptShared = toFlag True, - ghcOptDynLinkMode = toFlag GhcDynamicOnly, - ghcOptInputFiles = dynamicObjectFiles, - ghcOptOutputFile = toFlag sharedLibFilePath, - -- For dynamic libs, Mac OS/X needs to know the install location - -- at build time. This only applies to GHC < 7.8 - see the - -- discussion in #1660. - ghcOptDylibName = if (hostOS == OSX - && ghcVersion < Version [7,8] []) - then toFlag sharedLibInstallPath - else mempty, - ghcOptPackageName = toFlag pkgid, - ghcOptNoAutoLinkPackages = toFlag True, - ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = componentPackageDeps clbi, - ghcOptLinkLibs = extraLibs libBi, - ghcOptLinkLibPath = extraLibDirs libBi - } - - whenVanillaLib False $ do - Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles - - whenProfLib $ do - Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles - - whenGHCiLib $ do - (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi) - Ld.combineObjectFiles verbosity ldProg - ghciLibFilePath ghciObjFiles - - whenSharedLib False $ - runGhcProg ghcSharedLinkArgs - --- | Start a REPL without loading any source files. -startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler - -> PackageDBStack -> IO () -startInterpreter verbosity conf comp packageDBs = do - let replOpts = mempty { - ghcOptMode = toFlag GhcModeInteractive, - ghcOptPackageDBs = packageDBs - } - checkPackageDbStack packageDBs - (ghcProg, _) <- requireProgram verbosity ghcProgram conf - runGHC verbosity ghcProg comp replOpts - --- | Build an executable with GHC. --- -buildExe, replExe :: Verbosity -> Cabal.Flag (Maybe Int) - -> PackageDescription -> LocalBuildInfo - -> Executable -> ComponentLocalBuildInfo -> IO () -buildExe = buildOrReplExe False -replExe = buildOrReplExe True - -buildOrReplExe :: Bool -> Verbosity -> Cabal.Flag (Maybe Int) - -> PackageDescription -> LocalBuildInfo - -> Executable -> ComponentLocalBuildInfo -> IO () -buildOrReplExe forRepl verbosity numJobsFlag _pkg_descr lbi - exe@Executable { exeName = exeName', modulePath = modPath } clbi = do - - (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) - let comp = compiler lbi - numJobs = fromMaybe 1 $ - fromFlagOrDefault Nothing numJobsFlag - runGhcProg = runGHC verbosity ghcProg comp - - exeBi <- hackThreadedFlag verbosity - comp (withProfExe lbi) (buildInfo exe) - - -- exeNameReal, the name that GHC really uses (with .exe on Windows) - let exeNameReal = exeName' <.> - (if takeExtension exeName' /= ('.':exeExtension) - then exeExtension - else "") - - let targetDir = (buildDir lbi) exeName' - let exeDir = targetDir (exeName' ++ "-tmp") - createDirectoryIfMissingVerbose verbosity True targetDir - createDirectoryIfMissingVerbose verbosity True exeDir - -- TODO: do we need to put hs-boot files into place for mutually recursive - -- modules? FIX: what about exeName.hi-boot? - - -- build executables - - srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath - let isGhcDynamic = ghcDynamic comp - dynamicTooSupported = ghcSupportsDynamicToo comp - isHaskellMain = elem (takeExtension srcMainFile) [".hs", ".lhs"] - cSrcs = cSources exeBi ++ [srcMainFile | not isHaskellMain] - cObjs = map (`replaceExtension` objExtension) cSrcs - baseOpts = (componentGhcOptions verbosity lbi exeBi clbi exeDir) - `mappend` mempty { - ghcOptMode = toFlag GhcModeMake, - ghcOptInputFiles = - [ srcMainFile | isHaskellMain], - ghcOptInputModules = - [ m | not isHaskellMain, m <- exeModules exe] - } - staticOpts = baseOpts `mappend` mempty { - ghcOptDynLinkMode = toFlag GhcStaticOnly - } - profOpts = baseOpts `mappend` mempty { - ghcOptProfilingMode = toFlag True, - ghcOptHiSuffix = toFlag "p_hi", - ghcOptObjSuffix = toFlag "p_o", - ghcOptExtra = ghcProfOptions exeBi - } - dynOpts = baseOpts `mappend` mempty { - ghcOptDynLinkMode = toFlag GhcDynamicOnly, - ghcOptHiSuffix = toFlag "dyn_hi", - ghcOptObjSuffix = toFlag "dyn_o", - ghcOptExtra = ghcSharedOptions exeBi - } - dynTooOpts = staticOpts `mappend` mempty { - ghcOptDynLinkMode = toFlag GhcStaticAndDynamic, - ghcOptDynHiSuffix = toFlag "dyn_hi", - ghcOptDynObjSuffix = toFlag "dyn_o" - } - linkerOpts = mempty { - ghcOptLinkOptions = PD.ldOptions exeBi, - ghcOptLinkLibs = extraLibs exeBi, - ghcOptLinkLibPath = extraLibDirs exeBi, - ghcOptLinkFrameworks = PD.frameworks exeBi, - ghcOptInputFiles = [exeDir x | x <- cObjs] - } - replOpts = baseOpts { - ghcOptExtra = filterGhciFlags - (ghcOptExtra baseOpts) - } - -- For a normal compile we do separate invocations of ghc for - -- compiling as for linking. But for repl we have to do just - -- the one invocation, so that one has to include all the - -- linker stuff too, like -l flags and any .o files from C - -- files etc. - `mappend` linkerOpts - `mappend` mempty { - ghcOptMode = toFlag GhcModeInteractive, - ghcOptOptimisation = toFlag GhcNoOptimisation - } - commonOpts | withProfExe lbi = profOpts - | withDynExe lbi = dynOpts - | otherwise = staticOpts - compileOpts | useDynToo = dynTooOpts - | otherwise = commonOpts - withStaticExe = (not $ withProfExe lbi) && (not $ withDynExe lbi) - - -- For building exe's that use TH with -prof or -dynamic we actually have - -- to build twice, once without -prof/-dynamic and then again with - -- -prof/-dynamic. This is because the code that TH needs to run at - -- compile time needs to be the vanilla ABI so it can be loaded up and run - -- by the compiler. - -- With dynamic-by-default GHC the TH object files loaded at compile-time - -- need to be .dyn_o instead of .o. - doingTH = EnableExtension TemplateHaskell `elem` allExtensions exeBi - -- Should we use -dynamic-too instead of compiling twice? - useDynToo = dynamicTooSupported && isGhcDynamic - && doingTH && withStaticExe && null (ghcSharedOptions exeBi) - compileTHOpts | isGhcDynamic = dynOpts - | otherwise = staticOpts - compileForTH - | forRepl = False - | useDynToo = False - | isGhcDynamic = doingTH && (withProfExe lbi || withStaticExe) - | otherwise = doingTH && (withProfExe lbi || withDynExe lbi) - - linkOpts = commonOpts `mappend` - linkerOpts `mappend` mempty { - ghcOptLinkNoHsMain = toFlag (not isHaskellMain) - } - - -- Build static/dynamic object files for TH, if needed. - when compileForTH $ - runGhcProg compileTHOpts { ghcOptNoLink = toFlag True - , ghcOptNumJobs = toFlag numJobs } - - unless forRepl $ - runGhcProg compileOpts { ghcOptNoLink = toFlag True - , ghcOptNumJobs = toFlag numJobs } - - -- build any C sources - unless (null cSrcs) $ do - info verbosity "Building C Sources..." - sequence_ - [ do let opts = (componentCcGhcOptions verbosity lbi exeBi clbi - exeDir filename) `mappend` mempty { - ghcOptDynLinkMode = toFlag (if withDynExe lbi - then GhcDynamicOnly - else GhcStaticOnly), - ghcOptProfilingMode = toFlag (withProfExe lbi) - } - odir = fromFlag (ghcOptObjDir opts) - createDirectoryIfMissingVerbose verbosity True odir - runGhcProg opts - | filename <- cSrcs ] - - -- TODO: problem here is we need the .c files built first, so we can load them - -- with ghci, but .c files can depend on .h files generated by ghc by ffi - -- exports. - when forRepl $ runGhcProg replOpts - - -- link: - unless forRepl $ do - info verbosity "Linking..." - runGhcProg linkOpts { ghcOptOutputFile = toFlag (targetDir exeNameReal) } - - --- | Filter the "-threaded" flag when profiling as it does not --- work with ghc-6.8 and older. -hackThreadedFlag :: Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfo -hackThreadedFlag verbosity comp prof bi - | not mustFilterThreaded = return bi - | otherwise = do - warn verbosity $ "The ghc flag '-threaded' is not compatible with " - ++ "profiling in ghc-6.8 and older. It will be disabled." - return bi { options = filterHcOptions (/= "-threaded") (options bi) } - where - mustFilterThreaded = prof && compilerVersion comp < Version [6, 10] [] - && "-threaded" `elem` hcOptions GHC bi - filterHcOptions p hcoptss = - [ (hc, if hc == GHC then filter p opts else opts) - | (hc, opts) <- hcoptss ] - --- | Strip out flags that are not supported in ghci -filterGhciFlags :: [String] -> [String] -filterGhciFlags = filter supported - where - supported ('-':'O':_) = False - supported "-debug" = False - supported "-threaded" = False - supported "-ticky" = False - supported "-eventlog" = False - supported "-prof" = False - supported "-unreg" = False - supported _ = True - --- when using -split-objs, we need to search for object files in the --- Module_split directory for each module. -getHaskellObjects :: Library -> LocalBuildInfo - -> FilePath -> String -> Bool -> IO [FilePath] -getHaskellObjects lib lbi pref wanted_obj_ext allow_split_objs - | splitObjs lbi && allow_split_objs = do - let splitSuffix = if compilerVersion (compiler lbi) < - Version [6, 11] [] - then "_split" - else "_" ++ wanted_obj_ext ++ "_split" - dirs = [ pref (ModuleName.toFilePath x ++ splitSuffix) - | x <- libModules lib ] - objss <- mapM getDirectoryContents dirs - let objs = [ dir obj - | (objs',dir) <- zip objss dirs, obj <- objs', - let obj_ext = takeExtension obj, - '.':wanted_obj_ext == obj_ext ] - return objs - | otherwise = - return [ pref ModuleName.toFilePath x <.> wanted_obj_ext - | x <- libModules lib ] - --- | Extracts a String representing a hash of the ABI of a built --- library. It can fail if the library has not yet been built. --- -libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo - -> Library -> ComponentLocalBuildInfo -> IO String -libAbiHash verbosity pkg_descr lbi lib clbi = do - libBi <- hackThreadedFlag verbosity - (compiler lbi) (withProfLib lbi) (libBuildInfo lib) - let - comp = compiler lbi - vanillaArgs = - (componentGhcOptions verbosity lbi libBi clbi (buildDir lbi)) - `mappend` mempty { - ghcOptMode = toFlag GhcModeAbiHash, - ghcOptPackageName = toFlag (packageId pkg_descr), - ghcOptInputModules = exposedModules lib - } - sharedArgs = vanillaArgs `mappend` mempty { - ghcOptDynLinkMode = toFlag GhcDynamicOnly, - ghcOptFPic = toFlag True, - ghcOptHiSuffix = toFlag "dyn_hi", - ghcOptObjSuffix = toFlag "dyn_o", - ghcOptExtra = ghcSharedOptions libBi - } - profArgs = vanillaArgs `mappend` mempty { - ghcOptProfilingMode = toFlag True, - ghcOptHiSuffix = toFlag "p_hi", - ghcOptObjSuffix = toFlag "p_o", - ghcOptExtra = ghcProfOptions libBi - } - ghcArgs = if withVanillaLib lbi then vanillaArgs - else if withSharedLib lbi then sharedArgs - else if withProfLib lbi then profArgs - else error "libAbiHash: Can't find an enabled library way" - -- - (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) - getProgramInvocationOutput verbosity (ghcInvocation ghcProg comp ghcArgs) - - -componentGhcOptions :: Verbosity -> LocalBuildInfo - -> BuildInfo -> ComponentLocalBuildInfo -> FilePath - -> GhcOptions -componentGhcOptions verbosity lbi bi clbi odir = - mempty { - ghcOptVerbosity = toFlag verbosity, - ghcOptHideAllPackages = toFlag True, - ghcOptCabal = toFlag True, - ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = componentPackageDeps clbi, - ghcOptSplitObjs = toFlag (splitObjs lbi), - ghcOptSourcePathClear = toFlag True, - ghcOptSourcePath = [odir] ++ nub (hsSourceDirs bi) - ++ [autogenModulesDir lbi], - ghcOptCppIncludePath = [autogenModulesDir lbi, odir] - ++ PD.includeDirs bi, - ghcOptCppOptions = cppOptions bi, - ghcOptCppIncludes = [autogenModulesDir lbi cppHeaderName], - ghcOptFfiIncludes = PD.includes bi, - ghcOptObjDir = toFlag odir, - ghcOptHiDir = toFlag odir, - ghcOptStubDir = toFlag odir, - ghcOptOutputDir = toFlag odir, - ghcOptOptimisation = toGhcOptimisation (withOptimization lbi), - ghcOptExtra = hcOptions GHC bi, - ghcOptLanguage = toFlag (fromMaybe Haskell98 (defaultLanguage bi)), - -- Unsupported extensions have already been checked by configure - ghcOptExtensions = usedExtensions bi, - ghcOptExtensionMap = compilerExtensions (compiler lbi) - } - where - toGhcOptimisation NoOptimisation = mempty --TODO perhaps override? - toGhcOptimisation NormalOptimisation = toFlag GhcNormalOptimisation - toGhcOptimisation MaximumOptimisation = toFlag GhcMaximumOptimisation - - -componentCcGhcOptions :: Verbosity -> LocalBuildInfo - -> BuildInfo -> ComponentLocalBuildInfo - -> FilePath -> FilePath - -> GhcOptions -componentCcGhcOptions verbosity lbi bi clbi pref filename = - mempty { - ghcOptVerbosity = toFlag verbosity, - ghcOptMode = toFlag GhcModeCompile, - ghcOptInputFiles = [filename], - - ghcOptCppIncludePath = [autogenModulesDir lbi, odir] - ++ PD.includeDirs bi, - ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = componentPackageDeps clbi, - ghcOptCcOptions = PD.ccOptions bi - ++ case withOptimization lbi of - NoOptimisation -> [] - _ -> ["-O2"], - ghcOptObjDir = toFlag odir - } - where - odir | compilerVersion (compiler lbi) >= Version [6,4,1] [] = pref - | otherwise = pref takeDirectory filename - -- ghc 6.4.0 had a bug in -odir handling for C compilations. - -mkGHCiLibName :: LibraryName -> String -mkGHCiLibName (LibraryName lib) = lib <.> "o" - --- ----------------------------------------------------------------------------- --- Installing - --- |Install executables for GHC. -installExe :: Verbosity - -> LocalBuildInfo - -> InstallDirs FilePath -- ^Where to copy the files to - -> FilePath -- ^Build location - -> (FilePath, FilePath) -- ^Executable (prefix,suffix) - -> PackageDescription - -> Executable - -> IO () -installExe verbosity lbi installDirs buildPref - (progprefix, progsuffix) _pkg exe = do - let binDir = bindir installDirs - createDirectoryIfMissingVerbose verbosity True binDir - let exeFileName = exeName exe <.> exeExtension - fixedExeBaseName = progprefix ++ exeName exe ++ progsuffix - installBinary dest = do - installExecutableFile verbosity - (buildPref exeName exe exeFileName) - (dest <.> exeExtension) - when (stripExes lbi) $ - Strip.stripExe verbosity (hostPlatform lbi) (withPrograms lbi) - (dest <.> exeExtension) - installBinary (binDir fixedExeBaseName) - --- |Install for ghc, .hi, .a and, if --with-ghci given, .o -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 - -- copy .hi files over: - whenVanilla $ copyModuleFiles "hi" - whenProf $ copyModuleFiles "p_hi" - whenShared $ copyModuleFiles "dyn_hi" - - -- copy the built library files over: - whenVanilla $ mapM_ (installOrdinary builtDir targetDir) vanillaLibNames - whenProf $ mapM_ (installOrdinary builtDir targetDir) profileLibNames - whenGHCi $ mapM_ (installOrdinary builtDir targetDir) ghciLibNames - whenShared $ mapM_ (installShared builtDir dynlibTargetDir) sharedLibNames - - where - install isShared srcDir dstDir name = do - let src = srcDir name - dst = dstDir name - createDirectoryIfMissingVerbose verbosity True dstDir - if isShared - then do when (stripLibs lbi) $ Strip.stripLib verbosity - (hostPlatform lbi) (withPrograms lbi) src - installExecutableFile verbosity src dst - else installOrdinaryFile verbosity src dst - - installOrdinary = install False - installShared = install True - - copyModuleFiles ext = - findModuleFiles [builtDir] [ext] (libModules lib) - >>= installOrdinaryFiles verbosity targetDir - - cid = compilerId (compiler lbi) - libNames = componentLibraries clbi - vanillaLibNames = map mkLibName libNames - profileLibNames = map mkProfLibName libNames - ghciLibNames = map mkGHCiLibName libNames - sharedLibNames = map (mkSharedLibName cid) libNames - - hasLib = not $ null (libModules lib) - && null (cSources (libBuildInfo lib)) - whenVanilla = when (hasLib && withVanillaLib lbi) - whenProf = when (hasLib && withProfLib lbi) - whenGHCi = when (hasLib && withGHCiLib lbi) - whenShared = when (hasLib && withSharedLib lbi) - --- ----------------------------------------------------------------------------- --- Registering - --- | Create an empty package DB at the specified location. -initPackageDB :: Verbosity -> ProgramConfiguration -> FilePath -> IO () -initPackageDB verbosity conf dbPath = HcPkg.init verbosity ghcPkgProg dbPath - where - Just ghcPkgProg = lookupProgram ghcPkgProgram conf - --- | Run 'ghc-pkg' using a given package DB stack, directly forwarding the --- provided command-line arguments to it. -invokeHcPkg :: Verbosity -> ProgramConfiguration -> PackageDBStack -> [String] - -> IO () -invokeHcPkg verbosity conf dbStack extraArgs = - HcPkg.invoke verbosity ghcPkgProg dbStack extraArgs - where - Just ghcPkgProg = lookupProgram ghcPkgProgram conf - -registerPackage - :: Verbosity - -> InstalledPackageInfo - -> PackageDescription - -> LocalBuildInfo - -> Bool - -> PackageDBStack - -> IO () -registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do - let Just ghcPkg = lookupProgram ghcPkgProgram (withPrograms lbi) - HcPkg.reregister verbosity ghcPkg packageDbs (Right installedPkgInfo) - --- ----------------------------------------------------------------------------- --- Utils - -ghcLookupProperty :: String -> Compiler -> Bool -ghcLookupProperty prop comp = - case M.lookup prop (compilerProperties comp) of - Just "YES" -> True - _ -> False - -ghcDynamic :: Compiler -> Bool -ghcDynamic = ghcLookupProperty "GHC Dynamic" - -ghcSupportsDynamicToo :: Compiler -> Bool -ghcSupportsDynamicToo = ghcLookupProperty "Support dynamic-too" + hcPkgInfo, + registerPackage, + componentGhcOptions, + getLibDir, + isDynamic, + getGlobalPackageDB, + pkgRoot + ) where + +import qualified Distribution.Simple.GHC.IPI641 as IPI641 +import qualified Distribution.Simple.GHC.IPI642 as IPI642 +import qualified Distribution.Simple.GHC.Internal as Internal +import Distribution.Simple.GHC.ImplInfo +import Distribution.PackageDescription as PD + ( PackageDescription(..), BuildInfo(..), Executable(..), Library(..) + , allExtensions, libModules, exeModules + , hcOptions, hcSharedOptions, hcProfOptions ) +import Distribution.InstalledPackageInfo + ( InstalledPackageInfo ) +import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo + ( InstalledPackageInfo_(..) ) +import Distribution.Simple.PackageIndex (InstalledPackageIndex) +import qualified Distribution.Simple.PackageIndex as PackageIndex +import Distribution.Simple.LocalBuildInfo + ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) + , absoluteInstallDirs, depLibraryPaths ) +import qualified Distribution.Simple.Hpc as Hpc +import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs ) +import Distribution.Simple.BuildPaths +import Distribution.Simple.Utils +import Distribution.Package + ( PackageName(..) ) +import qualified Distribution.ModuleName as ModuleName +import Distribution.Simple.Program + ( Program(..), ConfiguredProgram(..), ProgramConfiguration + , ProgramSearchPath + , rawSystemProgramStdout, rawSystemProgramStdoutConf + , getProgramInvocationOutput, requireProgramVersion, requireProgram + , userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram + , ghcProgram, ghcPkgProgram, hsc2hsProgram, ldProgram ) +import qualified Distribution.Simple.Program.HcPkg as HcPkg +import qualified Distribution.Simple.Program.Ar as Ar +import qualified Distribution.Simple.Program.Ld as Ld +import qualified Distribution.Simple.Program.Strip as Strip +import Distribution.Simple.Program.GHC +import Distribution.Simple.Setup + ( toFlag, fromFlag, configCoverage, configDistPref ) +import qualified Distribution.Simple.Setup as Cabal + ( Flag(..) ) +import Distribution.Simple.Compiler + ( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion + , PackageDB(..), PackageDBStack, AbiTag(..) ) +import Distribution.Version + ( Version(..), anyVersion, orLaterVersion ) +import Distribution.System + ( Platform(..), OS(..) ) +import Distribution.Verbosity +import Distribution.Text + ( display ) +import Distribution.Utils.NubList + ( NubListR, overNubListR, toNubListR ) +import Language.Haskell.Extension (Extension(..), KnownExtension(..)) + +import Control.Monad ( unless, when ) +import Data.Char ( isDigit, isSpace ) +import Data.List +import qualified Data.Map as M ( fromList ) +import Data.Maybe ( catMaybes ) +import Data.Monoid ( Monoid(..) ) +import Data.Version ( showVersion ) +import System.Directory + ( doesFileExist, getAppUserDataDirectory, createDirectoryIfMissing ) +import System.FilePath ( (), (<.>), takeExtension, + takeDirectory, replaceExtension, + splitExtension, isRelative ) +import qualified System.Info + +-- ----------------------------------------------------------------------------- +-- Configuring + +configure :: Verbosity -> Maybe FilePath -> Maybe FilePath + -> ProgramConfiguration + -> IO (Compiler, Maybe Platform, ProgramConfiguration) +configure verbosity hcPath hcPkgPath conf0 = do + + (ghcProg, ghcVersion, conf1) <- + requireProgramVersion verbosity ghcProgram + (orLaterVersion (Version [6,4] [])) + (userMaybeSpecifyPath "ghc" hcPath conf0) + let implInfo = ghcVersionImplInfo 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, conf2) <- + requireProgramVersion verbosity ghcPkgProgram { + programFindLocation = guessGhcPkgFromGhcPath ghcProg + } + anyVersion (userMaybeSpecifyPath "ghc-pkg" hcPkgPath conf1) + + when (ghcVersion /= ghcPkgVersion) $ die $ + "Version mismatch between ghc and ghc-pkg: " + ++ programPath ghcProg ++ " is version " ++ display ghcVersion ++ " " + ++ programPath ghcPkgProg ++ " is version " ++ display ghcPkgVersion + + -- Likewise we try to find the matching hsc2hs program. + let hsc2hsProgram' = hsc2hsProgram { + programFindLocation = guessHsc2hsFromGhcPath ghcProg + } + conf3 = addKnownProgram hsc2hsProgram' conf2 + + languages <- Internal.getLanguages verbosity implInfo ghcProg + extensions <- Internal.getExtensions verbosity implInfo ghcProg + + ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcProg + let ghcInfoMap = M.fromList ghcInfo + + let comp = Compiler { + compilerId = CompilerId GHC ghcVersion, + compilerAbiTag = NoAbiTag, + compilerCompat = [], + compilerLanguages = languages, + compilerExtensions = extensions, + compilerProperties = ghcInfoMap + } + compPlatform = Internal.targetPlatform ghcInfo + conf4 = Internal.configureToolchain implInfo ghcProg ghcInfoMap conf3 -- configure gcc and ld + return (comp, compPlatform, conf4) + +-- | 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: +-- +-- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe) +-- > /usr/local/bin/ghc-pkg-6.6.1(.exe) +-- > /usr/local/bin/ghc-pkg(.exe) +-- +guessToolFromGhcPath :: Program -> ConfiguredProgram + -> Verbosity -> ProgramSearchPath + -> IO (Maybe FilePath) +guessToolFromGhcPath tool ghcProg verbosity searchpath + = do let toolname = programName tool + path = programPath ghcProg + dir = takeDirectory path + versionSuffix = takeVersionSuffix (dropExeExtension path) + guessNormal = dir toolname <.> exeExtension + guessGhcVersioned = dir (toolname ++ "-ghc" ++ versionSuffix) + <.> exeExtension + guessVersioned = dir (toolname ++ versionSuffix) + <.> exeExtension + guesses | null versionSuffix = [guessNormal] + | otherwise = [guessGhcVersioned, + guessVersioned, + guessNormal] + info verbosity $ "looking for tool " ++ toolname + ++ " near compiler in " ++ dir + exists <- mapM doesFileExist guesses + case [ file | (file, True) <- zip guesses exists ] of + -- If we can't find it near ghc, fall back to the usual + -- method. + [] -> programFindLocation tool verbosity searchpath + (fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp + return (Just fp) + + where takeVersionSuffix :: FilePath -> String + takeVersionSuffix = takeWhileEndLE isSuffixChar + + isSuffixChar :: Char -> Bool + isSuffixChar c = isDigit c || c == '.' || c == '-' + + dropExeExtension :: FilePath -> FilePath + dropExeExtension filepath = + case splitExtension filepath of + (filepath', extension) | extension == exeExtension -> filepath' + | otherwise -> filepath + +-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a +-- corresponding ghc-pkg, we try looking for both a versioned and unversioned +-- ghc-pkg in the same dir, that is: +-- +-- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe) +-- > /usr/local/bin/ghc-pkg-6.6.1(.exe) +-- > /usr/local/bin/ghc-pkg(.exe) +-- +guessGhcPkgFromGhcPath :: ConfiguredProgram + -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath) +guessGhcPkgFromGhcPath = guessToolFromGhcPath ghcPkgProgram + +-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a +-- corresponding hsc2hs, we try looking for both a versioned and unversioned +-- hsc2hs in the same dir, that is: +-- +-- > /usr/local/bin/hsc2hs-ghc-6.6.1(.exe) +-- > /usr/local/bin/hsc2hs-6.6.1(.exe) +-- > /usr/local/bin/hsc2hs(.exe) +-- +guessHsc2hsFromGhcPath :: ConfiguredProgram + -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath) +guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram + +getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)] +getGhcInfo verbosity ghcProg = Internal.getGhcInfo verbosity implInfo ghcProg + where + Just version = programVersion ghcProg + implInfo = ghcVersionImplInfo version + +-- | Given a single package DB, return all installed packages. +getPackageDBContents :: Verbosity -> PackageDB -> ProgramConfiguration + -> IO InstalledPackageIndex +getPackageDBContents verbosity packagedb conf = do + pkgss <- getInstalledPackages' verbosity [packagedb] conf + toPackageIndex verbosity pkgss conf + +-- | Given a package DB stack, return all installed packages. +getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration + -> IO InstalledPackageIndex +getInstalledPackages verbosity packagedbs conf = do + checkPackageDbEnvVar + checkPackageDbStack packagedbs + pkgss <- getInstalledPackages' verbosity packagedbs conf + index <- toPackageIndex verbosity pkgss conf + return $! hackRtsPackage index + + where + hackRtsPackage index = + case PackageIndex.lookupPackageName index (PackageName "rts") of + [(_,[rts])] + -> PackageIndex.insert (removeMingwIncludeDir rts) index + _ -> index -- No (or multiple) ghc rts package is registered!! + -- Feh, whatever, the ghc test suite does some crazy stuff. + +-- | Given a list of @(PackageDB, InstalledPackageInfo)@ pairs, produce a +-- @PackageIndex@. Helper function used by 'getPackageDBContents' and +-- 'getInstalledPackages'. +toPackageIndex :: Verbosity + -> [(PackageDB, [InstalledPackageInfo])] + -> ProgramConfiguration + -> IO InstalledPackageIndex +toPackageIndex verbosity pkgss conf = do + -- On Windows, various fields have $topdir/foo rather than full + -- paths. We need to substitute the right value in so that when + -- we, for example, call gcc, we have proper paths to give it. + topDir <- getLibDir' verbosity ghcProg + let indices = [ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs) + | (_, pkgs) <- pkgss ] + return $! (mconcat indices) + + where + Just ghcProg = lookupProgram ghcProgram conf + +getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath +getLibDir verbosity lbi = + dropWhileEndLE isSpace `fmap` + rawSystemProgramStdoutConf verbosity ghcProgram + (withPrograms lbi) ["--print-libdir"] + +getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath +getLibDir' verbosity ghcProg = + dropWhileEndLE isSpace `fmap` + rawSystemProgramStdout verbosity ghcProg ["--print-libdir"] + + +-- | Return the 'FilePath' to the global GHC package database. +getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath +getGlobalPackageDB verbosity ghcProg = + dropWhileEndLE isSpace `fmap` + rawSystemProgramStdout verbosity ghcProg ["--print-global-package-db"] + +checkPackageDbEnvVar :: IO () +checkPackageDbEnvVar = + Internal.checkPackageDbEnvVar "GHC" "GHC_PACKAGE_PATH" + +checkPackageDbStack :: PackageDBStack -> IO () +checkPackageDbStack (GlobalPackageDB:rest) + | GlobalPackageDB `notElem` rest = return () +checkPackageDbStack rest + | GlobalPackageDB `notElem` rest = + die $ "With current ghc versions the global package db is always used " + ++ "and must be listed first. This ghc limitation may be lifted in " + ++ "future, see http://hackage.haskell.org/trac/ghc/ticket/5977" +checkPackageDbStack _ = + die $ "If the global package db is specified, it must be " + ++ "specified first and cannot be specified multiple times" + +-- GHC < 6.10 put "$topdir/include/mingw" in rts's installDirs. This +-- breaks when you want to use a different gcc, so we need to filter +-- it out. +removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo +removeMingwIncludeDir pkg = + let ids = InstalledPackageInfo.includeDirs pkg + ids' = filter (not . ("mingw" `isSuffixOf`)) ids + in pkg { InstalledPackageInfo.includeDirs = ids' } + +-- | Get the packages from specific PackageDBs, not cumulative. +-- +getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramConfiguration + -> IO [(PackageDB, [InstalledPackageInfo])] +getInstalledPackages' verbosity packagedbs conf + | ghcVersion >= Version [6,9] [] = + sequence + [ do pkgs <- HcPkg.dump (hcPkgInfo conf) verbosity packagedb + return (packagedb, pkgs) + | packagedb <- packagedbs ] + + where + Just ghcProg = lookupProgram ghcProgram conf + Just ghcVersion = programVersion ghcProg + +getInstalledPackages' verbosity packagedbs conf = do + str <- rawSystemProgramStdoutConf verbosity ghcPkgProgram conf ["list"] + let pkgFiles = [ init line | line <- lines str, last line == ':' ] + dbFile packagedb = case (packagedb, pkgFiles) of + (GlobalPackageDB, global:_) -> return $ Just global + (UserPackageDB, _global:user:_) -> return $ Just user + (UserPackageDB, _global:_) -> return $ Nothing + (SpecificPackageDB specific, _) -> return $ Just specific + _ -> die "cannot read ghc-pkg package listing" + pkgFiles' <- mapM dbFile packagedbs + sequence [ withFileContents file $ \content -> do + pkgs <- readPackages file content + return (db, pkgs) + | (db , Just file) <- zip packagedbs pkgFiles' ] + where + -- Depending on the version of ghc we use a different type's Read + -- instance to parse the package file and then convert. + -- It's a bit yuck. But that's what we get for using Read/Show. + readPackages + | ghcVersion >= Version [6,4,2] [] + = \file content -> case reads content of + [(pkgs, _)] -> return (map IPI642.toCurrent pkgs) + _ -> failToRead file + | otherwise + = \file content -> case reads content of + [(pkgs, _)] -> return (map IPI641.toCurrent pkgs) + _ -> failToRead file + Just ghcProg = lookupProgram ghcProgram conf + Just ghcVersion = programVersion ghcProg + failToRead file = die $ "cannot read ghc package database " ++ file + +-- ----------------------------------------------------------------------------- +-- Building + +-- | Build a library with GHC. +-- +buildLib, replLib :: Verbosity -> Cabal.Flag (Maybe Int) + -> PackageDescription -> LocalBuildInfo + -> Library -> ComponentLocalBuildInfo -> IO () +buildLib = buildOrReplLib False +replLib = buildOrReplLib True + +buildOrReplLib :: Bool -> Verbosity -> Cabal.Flag (Maybe Int) + -> PackageDescription -> LocalBuildInfo + -> Library -> ComponentLocalBuildInfo -> IO () +buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do + libName <- case componentLibraries clbi of + [libName] -> return libName + [] -> die "No library name found when building library" + _ -> die "Multiple library names found when building library" + + let libTargetDir = buildDir lbi + whenVanillaLib forceVanilla = + when (forceVanilla || withVanillaLib lbi) + whenProfLib = when (withProfLib lbi) + whenSharedLib forceShared = + when (forceShared || withSharedLib lbi) + whenGHCiLib = when (withGHCiLib lbi && withVanillaLib lbi) + ifReplLib = when forRepl + comp = compiler lbi + ghcVersion = compilerVersion comp + implInfo = getImplInfo comp + (Platform _hostArch hostOS) = hostPlatform lbi + hole_insts = map (\(k,(p,n)) -> (k,(InstalledPackageInfo.packageKey p,n))) (instantiatedWith lbi) + + (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) + let runGhcProg = runGHC verbosity ghcProg comp + + libBi <- hackThreadedFlag verbosity + comp (withProfLib lbi) (libBuildInfo lib) + + let isGhcDynamic = isDynamic comp + dynamicTooSupported = supportsDynamicToo comp + doingTH = EnableExtension TemplateHaskell `elem` allExtensions libBi + forceVanillaLib = doingTH && not isGhcDynamic + forceSharedLib = doingTH && isGhcDynamic + -- TH always needs default libs, even when building for profiling + + -- Determine if program coverage should be enabled and if so, what + -- '-hpcdir' should be. + let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi + -- Component name. Not 'libName' because that has the "HS" prefix + -- that GHC gives Haskell libraries. + cname = display $ PD.package $ localPkgDescr lbi + distPref = fromFlag $ configDistPref $ configFlags lbi + hpcdir way + | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way cname + | otherwise = mempty + + createDirectoryIfMissingVerbose verbosity True libTargetDir + -- TODO: do we need to put hs-boot files into place for mutually recursive + -- modules? + let cObjs = map (`replaceExtension` objExtension) (cSources libBi) + baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir + vanillaOpts = baseOpts `mappend` mempty { + ghcOptMode = toFlag GhcModeMake, + ghcOptNumJobs = numJobs, + ghcOptPackageKey = toFlag (pkgKey lbi), + ghcOptSigOf = hole_insts, + ghcOptInputModules = toNubListR $ libModules lib, + ghcOptHPCDir = hpcdir Hpc.Vanilla + } + + profOpts = vanillaOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptHiSuffix = toFlag "p_hi", + ghcOptObjSuffix = toFlag "p_o", + ghcOptExtra = toNubListR $ hcProfOptions GHC libBi, + ghcOptHPCDir = hpcdir Hpc.Prof + } + + sharedOpts = vanillaOpts `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptFPic = toFlag True, + ghcOptHiSuffix = toFlag "dyn_hi", + ghcOptObjSuffix = toFlag "dyn_o", + ghcOptExtra = toNubListR $ hcSharedOptions GHC libBi, + ghcOptHPCDir = hpcdir Hpc.Dyn + } + linkerOpts = mempty { + ghcOptLinkOptions = toNubListR $ PD.ldOptions libBi, + ghcOptLinkLibs = toNubListR $ extraLibs libBi, + ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi, + ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi, + ghcOptInputFiles = toNubListR + [libTargetDir x | x <- cObjs] + } + replOpts = vanillaOpts { + ghcOptExtra = overNubListR + Internal.filterGhciFlags $ + (ghcOptExtra vanillaOpts), + ghcOptNumJobs = mempty + } + `mappend` linkerOpts + `mappend` mempty { + ghcOptMode = toFlag GhcModeInteractive, + ghcOptOptimisation = toFlag GhcNoOptimisation + } + + vanillaSharedOpts = vanillaOpts `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcStaticAndDynamic, + ghcOptDynHiSuffix = toFlag "dyn_hi", + ghcOptDynObjSuffix = toFlag "dyn_o", + ghcOptHPCDir = hpcdir Hpc.Dyn + } + + unless (forRepl || null (libModules lib)) $ + do let vanilla = whenVanillaLib forceVanillaLib (runGhcProg vanillaOpts) + shared = whenSharedLib forceSharedLib (runGhcProg sharedOpts) + useDynToo = dynamicTooSupported && + (forceVanillaLib || withVanillaLib lbi) && + (forceSharedLib || withSharedLib lbi) && + null (hcSharedOptions GHC libBi) + if useDynToo + then do + runGhcProg vanillaSharedOpts + case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of + (Cabal.Flag dynDir, Cabal.Flag vanillaDir) -> do + -- When the vanilla and shared library builds are done + -- in one pass, only one set of HPC module interfaces + -- are generated. This set should suffice for both + -- static and dynamically linked executables. We copy + -- the modules interfaces so they are available under + -- both ways. + copyDirectoryRecursive verbosity dynDir vanillaDir + _ -> return () + else if isGhcDynamic + then do shared; vanilla + else do vanilla; shared + whenProfLib (runGhcProg profOpts) + + -- build any C sources + unless (null (cSources libBi)) $ do + info verbosity "Building C Sources..." + sequence_ + [ do let baseCcOpts = Internal.componentCcGhcOptions verbosity implInfo + lbi libBi clbi libTargetDir filename + vanillaCcOpts = if isGhcDynamic + -- Dynamic GHC requires C sources to be built + -- with -fPIC for REPL to work. See #2207. + then baseCcOpts { ghcOptFPic = toFlag True } + else baseCcOpts + profCcOpts = vanillaCcOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptObjSuffix = toFlag "p_o" + } + sharedCcOpts = vanillaCcOpts `mappend` mempty { + ghcOptFPic = toFlag True, + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptObjSuffix = toFlag "dyn_o" + } + odir = fromFlag (ghcOptObjDir vanillaCcOpts) + createDirectoryIfMissingVerbose verbosity True odir + runGhcProg vanillaCcOpts + unless forRepl $ + whenSharedLib forceSharedLib (runGhcProg sharedCcOpts) + unless forRepl $ whenProfLib (runGhcProg profCcOpts) + | filename <- cSources libBi] + + -- TODO: problem here is we need the .c files built first, so we can load them + -- with ghci, but .c files can depend on .h files generated by ghc by ffi + -- exports. + unless (null (libModules lib)) $ + ifReplLib (runGhcProg replOpts) + + -- link: + unless forRepl $ do + info verbosity "Linking..." + let cProfObjs = map (`replaceExtension` ("p_" ++ objExtension)) + (cSources libBi) + cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension)) + (cSources libBi) + cid = compilerId (compiler lbi) + vanillaLibFilePath = libTargetDir mkLibName libName + profileLibFilePath = libTargetDir mkProfLibName libName + sharedLibFilePath = libTargetDir mkSharedLibName cid libName + ghciLibFilePath = libTargetDir Internal.mkGHCiLibName libName + libInstallPath = libdir $ absoluteInstallDirs pkg_descr lbi NoCopyDest + sharedLibInstallPath = libInstallPath mkSharedLibName cid libName + + stubObjs <- fmap catMaybes $ sequence + [ findFileWithExtension [objExtension] [libTargetDir] + (ModuleName.toFilePath x ++"_stub") + | ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files + , x <- libModules lib ] + stubProfObjs <- fmap catMaybes $ sequence + [ findFileWithExtension ["p_" ++ objExtension] [libTargetDir] + (ModuleName.toFilePath x ++"_stub") + | ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files + , x <- libModules lib ] + stubSharedObjs <- fmap catMaybes $ sequence + [ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir] + (ModuleName.toFilePath x ++"_stub") + | ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files + , x <- libModules lib ] + + hObjs <- Internal.getHaskellObjects implInfo lib lbi + libTargetDir objExtension True + hProfObjs <- + if (withProfLib lbi) + then Internal.getHaskellObjects implInfo lib lbi + libTargetDir ("p_" ++ objExtension) True + else return [] + hSharedObjs <- + if (withSharedLib lbi) + then Internal.getHaskellObjects implInfo lib lbi + libTargetDir ("dyn_" ++ objExtension) False + else return [] + + unless (null hObjs && null cObjs && null stubObjs) $ do + rpaths <- getRPaths lbi clbi + + let staticObjectFiles = + hObjs + ++ map (libTargetDir ) cObjs + ++ stubObjs + profObjectFiles = + hProfObjs + ++ map (libTargetDir ) cProfObjs + ++ stubProfObjs + ghciObjFiles = + hObjs + ++ map (libTargetDir ) cObjs + ++ stubObjs + dynamicObjectFiles = + hSharedObjs + ++ map (libTargetDir ) cSharedObjs + ++ stubSharedObjs + -- After the relocation lib is created we invoke ghc -shared + -- with the dependencies spelled out as -package arguments + -- and ghc invokes the linker with the proper library paths + ghcSharedLinkArgs = + mempty { + ghcOptShared = toFlag True, + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptInputFiles = toNubListR dynamicObjectFiles, + ghcOptOutputFile = toFlag sharedLibFilePath, + -- For dynamic libs, Mac OS/X needs to know the install location + -- at build time. This only applies to GHC < 7.8 - see the + -- discussion in #1660. + ghcOptDylibName = if (hostOS == OSX + && ghcVersion < Version [7,8] []) + then toFlag sharedLibInstallPath + else mempty, + ghcOptPackageKey = toFlag (pkgKey lbi), + ghcOptNoAutoLinkPackages = toFlag True, + ghcOptPackageDBs = withPackageDB lbi, + ghcOptPackages = toNubListR $ + Internal.mkGhcOptPackages clbi , + ghcOptLinkLibs = toNubListR $ extraLibs libBi, + ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi, + ghcOptRPaths = rpaths + } + + info verbosity (show (ghcOptPackages ghcSharedLinkArgs)) + + whenVanillaLib False $ do + Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles + + whenProfLib $ do + Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles + + whenGHCiLib $ do + (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi) + Ld.combineObjectFiles verbosity ldProg + ghciLibFilePath ghciObjFiles + + whenSharedLib False $ + runGhcProg ghcSharedLinkArgs + +-- | Start a REPL without loading any source files. +startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler + -> PackageDBStack -> IO () +startInterpreter verbosity conf comp packageDBs = do + let replOpts = mempty { + ghcOptMode = toFlag GhcModeInteractive, + ghcOptPackageDBs = packageDBs + } + checkPackageDbStack packageDBs + (ghcProg, _) <- requireProgram verbosity ghcProgram conf + runGHC verbosity ghcProg comp replOpts + +-- | Build an executable with GHC. +-- +buildExe, replExe :: Verbosity -> Cabal.Flag (Maybe Int) + -> PackageDescription -> LocalBuildInfo + -> Executable -> ComponentLocalBuildInfo -> IO () +buildExe = buildOrReplExe False +replExe = buildOrReplExe True + +buildOrReplExe :: Bool -> Verbosity -> Cabal.Flag (Maybe Int) + -> PackageDescription -> LocalBuildInfo + -> Executable -> ComponentLocalBuildInfo -> IO () +buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi + exe@Executable { exeName = exeName', modulePath = modPath } clbi = do + + (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) + let comp = compiler lbi + implInfo = getImplInfo comp + runGhcProg = runGHC verbosity ghcProg comp + + exeBi <- hackThreadedFlag verbosity + comp (withProfExe lbi) (buildInfo exe) + + -- exeNameReal, the name that GHC really uses (with .exe on Windows) + let exeNameReal = exeName' <.> + (if takeExtension exeName' /= ('.':exeExtension) + then exeExtension + else "") + + let targetDir = (buildDir lbi) exeName' + let exeDir = targetDir (exeName' ++ "-tmp") + createDirectoryIfMissingVerbose verbosity True targetDir + createDirectoryIfMissingVerbose verbosity True exeDir + -- 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 = fromFlag $ configCoverage $ configFlags lbi + distPref = fromFlag $ configDistPref $ configFlags lbi + hpcdir way + | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way exeName' + | otherwise = mempty + + -- build executables + + srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath + rpaths <- getRPaths lbi clbi + + let isGhcDynamic = isDynamic comp + dynamicTooSupported = supportsDynamicToo comp + isHaskellMain = elem (takeExtension srcMainFile) [".hs", ".lhs"] + cSrcs = cSources exeBi ++ [srcMainFile | not isHaskellMain] + cObjs = map (`replaceExtension` objExtension) cSrcs + baseOpts = (componentGhcOptions verbosity lbi exeBi clbi exeDir) + `mappend` mempty { + ghcOptMode = toFlag GhcModeMake, + ghcOptInputFiles = toNubListR + [ srcMainFile | isHaskellMain], + ghcOptInputModules = toNubListR + [ m | not isHaskellMain, m <- exeModules exe] + } + staticOpts = baseOpts `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcStaticOnly, + ghcOptHPCDir = hpcdir Hpc.Vanilla + } + profOpts = baseOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptHiSuffix = toFlag "p_hi", + ghcOptObjSuffix = toFlag "p_o", + ghcOptExtra = toNubListR $ hcProfOptions GHC exeBi, + ghcOptHPCDir = hpcdir Hpc.Prof + } + dynOpts = baseOpts `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptHiSuffix = toFlag "dyn_hi", + ghcOptObjSuffix = toFlag "dyn_o", + ghcOptExtra = toNubListR $ + hcSharedOptions GHC exeBi, + ghcOptHPCDir = hpcdir Hpc.Dyn + } + dynTooOpts = staticOpts `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcStaticAndDynamic, + ghcOptDynHiSuffix = toFlag "dyn_hi", + ghcOptDynObjSuffix = toFlag "dyn_o", + ghcOptHPCDir = hpcdir Hpc.Dyn + } + linkerOpts = mempty { + ghcOptLinkOptions = toNubListR $ PD.ldOptions exeBi, + ghcOptLinkLibs = toNubListR $ extraLibs exeBi, + ghcOptLinkLibPath = toNubListR $ extraLibDirs exeBi, + ghcOptLinkFrameworks = toNubListR $ PD.frameworks exeBi, + ghcOptInputFiles = toNubListR + [exeDir x | x <- cObjs], + ghcOptRPaths = rpaths + } + replOpts = baseOpts { + ghcOptExtra = overNubListR + Internal.filterGhciFlags + (ghcOptExtra baseOpts) + } + -- For a normal compile we do separate invocations of ghc for + -- compiling as for linking. But for repl we have to do just + -- the one invocation, so that one has to include all the + -- linker stuff too, like -l flags and any .o files from C + -- files etc. + `mappend` linkerOpts + `mappend` mempty { + ghcOptMode = toFlag GhcModeInteractive, + ghcOptOptimisation = toFlag GhcNoOptimisation + } + commonOpts | withProfExe lbi = profOpts + | withDynExe lbi = dynOpts + | otherwise = staticOpts + compileOpts | useDynToo = dynTooOpts + | otherwise = commonOpts + withStaticExe = (not $ withProfExe lbi) && (not $ withDynExe lbi) + + -- For building exe's that use TH with -prof or -dynamic we actually have + -- to build twice, once without -prof/-dynamic and then again with + -- -prof/-dynamic. This is because the code that TH needs to run at + -- compile time needs to be the vanilla ABI so it can be loaded up and run + -- by the compiler. + -- With dynamic-by-default GHC the TH object files loaded at compile-time + -- need to be .dyn_o instead of .o. + doingTH = EnableExtension TemplateHaskell `elem` allExtensions exeBi + -- Should we use -dynamic-too instead of compiling twice? + useDynToo = dynamicTooSupported && isGhcDynamic + && doingTH && withStaticExe + && null (hcSharedOptions GHC exeBi) + compileTHOpts | isGhcDynamic = dynOpts + | otherwise = staticOpts + compileForTH + | forRepl = False + | useDynToo = False + | isGhcDynamic = doingTH && (withProfExe lbi || withStaticExe) + | otherwise = doingTH && (withProfExe lbi || withDynExe lbi) + + linkOpts = commonOpts `mappend` + linkerOpts `mappend` mempty { + ghcOptLinkNoHsMain = toFlag (not isHaskellMain) + } + + -- Build static/dynamic object files for TH, if needed. + when compileForTH $ + runGhcProg compileTHOpts { ghcOptNoLink = toFlag True + , ghcOptNumJobs = numJobs } + + unless forRepl $ + runGhcProg compileOpts { ghcOptNoLink = toFlag True + , ghcOptNumJobs = numJobs } + + -- build any C sources + unless (null cSrcs) $ do + info verbosity "Building C Sources..." + sequence_ + [ do let opts = (Internal.componentCcGhcOptions verbosity implInfo lbi exeBi + clbi exeDir filename) `mappend` mempty { + ghcOptDynLinkMode = toFlag (if withDynExe lbi + then GhcDynamicOnly + else GhcStaticOnly), + ghcOptProfilingMode = toFlag (withProfExe lbi) + } + odir = fromFlag (ghcOptObjDir opts) + createDirectoryIfMissingVerbose verbosity True odir + runGhcProg opts + | filename <- cSrcs ] + + -- TODO: problem here is we need the .c files built first, so we can load them + -- with ghci, but .c files can depend on .h files generated by ghc by ffi + -- exports. + when forRepl $ runGhcProg replOpts + + -- link: + unless forRepl $ do + info verbosity "Linking..." + runGhcProg linkOpts { ghcOptOutputFile = toFlag (targetDir exeNameReal) } + +-- | Calculate the RPATHs for the component we are building. +-- +-- Calculates relative RPATHs when 'relocatable' is set. +getRPaths :: LocalBuildInfo + -> ComponentLocalBuildInfo -- ^ Component we are building + -> IO (NubListR FilePath) +getRPaths lbi clbi | supportRPaths hostOS = do + libraryPaths <- depLibraryPaths False (relocatable lbi) lbi clbi + let hostPref = case hostOS of + OSX -> "@loader_path" + _ -> "$ORIGIN" + relPath p = if isRelative p then hostPref p else p + rpaths = toNubListR (map relPath libraryPaths) + return rpaths + where + (Platform _ hostOS) = hostPlatform lbi + + -- The list of RPath-supported operating systems below reflects the + -- platforms on which Cabal's RPATH handling is tested. It does _NOT_ + -- reflect whether the OS supports RPATH. + + -- E.g. when this comment was written, the *BSD operating systems were + -- untested with regards to Cabal RPATH handling, and were hence set to + -- 'False', while those operating systems themselves do support RPATH. + supportRPaths Linux   = True + supportRPaths Windows = False + supportRPaths OSX   = True + supportRPaths FreeBSD   = False + supportRPaths OpenBSD   = False + supportRPaths NetBSD   = False + supportRPaths DragonFly = False + supportRPaths Solaris = False + supportRPaths AIX = False + supportRPaths HPUX = False + supportRPaths IRIX = False + supportRPaths HaLVM = False + supportRPaths IOS = False + supportRPaths Ghcjs = False + supportRPaths (OtherOS _) = False + -- Do _not_ add a default case so that we get a warning here when a new OS + -- is added. + +getRPaths _ _ = return mempty + +-- | Filter the "-threaded" flag when profiling as it does not +-- work with ghc-6.8 and older. +hackThreadedFlag :: Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfo +hackThreadedFlag verbosity comp prof bi + | not mustFilterThreaded = return bi + | otherwise = do + warn verbosity $ "The ghc flag '-threaded' is not compatible with " + ++ "profiling in ghc-6.8 and older. It will be disabled." + return bi { options = filterHcOptions (/= "-threaded") (options bi) } + where + mustFilterThreaded = prof && compilerVersion comp < Version [6, 10] [] + && "-threaded" `elem` hcOptions GHC bi + filterHcOptions p hcoptss = + [ (hc, if hc == GHC then filter p opts else opts) + | (hc, opts) <- hcoptss ] + + +-- | Extracts a String representing a hash of the ABI of a built +-- library. It can fail if the library has not yet been built. +-- +libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo + -> Library -> ComponentLocalBuildInfo -> IO String +libAbiHash verbosity _pkg_descr lbi lib clbi = do + libBi <- hackThreadedFlag verbosity + (compiler lbi) (withProfLib lbi) (libBuildInfo lib) + let + comp = compiler lbi + vanillaArgs = + (componentGhcOptions verbosity lbi libBi clbi (buildDir lbi)) + `mappend` mempty { + ghcOptMode = toFlag GhcModeAbiHash, + ghcOptPackageKey = toFlag (pkgKey lbi), + ghcOptInputModules = toNubListR $ exposedModules lib + } + sharedArgs = vanillaArgs `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptFPic = toFlag True, + ghcOptHiSuffix = toFlag "dyn_hi", + ghcOptObjSuffix = toFlag "dyn_o", + ghcOptExtra = toNubListR $ hcSharedOptions GHC libBi + } + profArgs = vanillaArgs `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptHiSuffix = toFlag "p_hi", + ghcOptObjSuffix = toFlag "p_o", + ghcOptExtra = toNubListR $ hcProfOptions GHC libBi + } + ghcArgs = if withVanillaLib lbi then vanillaArgs + else if withSharedLib lbi then sharedArgs + else if withProfLib lbi then profArgs + else error "libAbiHash: Can't find an enabled library way" + -- + (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) + hash <- getProgramInvocationOutput verbosity (ghcInvocation ghcProg comp ghcArgs) + return (takeWhile (not . isSpace) hash) + +componentGhcOptions :: Verbosity -> LocalBuildInfo + -> BuildInfo -> ComponentLocalBuildInfo -> FilePath + -> GhcOptions +componentGhcOptions = Internal.componentGhcOptions + +-- ----------------------------------------------------------------------------- +-- Installing + +-- |Install executables for GHC. +installExe :: Verbosity + -> LocalBuildInfo + -> InstallDirs FilePath -- ^Where to copy the files to + -> FilePath -- ^Build location + -> (FilePath, FilePath) -- ^Executable (prefix,suffix) + -> PackageDescription + -> Executable + -> IO () +installExe verbosity lbi installDirs buildPref + (progprefix, progsuffix) _pkg exe = do + let binDir = bindir installDirs + createDirectoryIfMissingVerbose verbosity True binDir + let exeFileName = exeName exe <.> exeExtension + fixedExeBaseName = progprefix ++ exeName exe ++ progsuffix + installBinary dest = do + installExecutableFile verbosity + (buildPref exeName exe exeFileName) + (dest <.> exeExtension) + when (stripExes lbi) $ + Strip.stripExe verbosity (hostPlatform lbi) (withPrograms lbi) + (dest <.> exeExtension) + installBinary (binDir fixedExeBaseName) + +-- |Install for ghc, .hi, .a and, if --with-ghci given, .o +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 + -- copy .hi files over: + whenVanilla $ copyModuleFiles "hi" + whenProf $ copyModuleFiles "p_hi" + whenShared $ copyModuleFiles "dyn_hi" + + -- copy the built library files over: + whenVanilla $ mapM_ (installOrdinary builtDir targetDir) vanillaLibNames + whenProf $ mapM_ (installOrdinary builtDir targetDir) profileLibNames + whenGHCi $ mapM_ (installOrdinary builtDir targetDir) ghciLibNames + whenShared $ mapM_ (installShared builtDir dynlibTargetDir) sharedLibNames + + where + install isShared srcDir dstDir name = do + let src = srcDir name + dst = dstDir name + createDirectoryIfMissingVerbose verbosity True dstDir + if isShared + then do when (stripLibs lbi) $ Strip.stripLib verbosity + (hostPlatform lbi) (withPrograms lbi) src + installExecutableFile verbosity src dst + else installOrdinaryFile verbosity src dst + + installOrdinary = install False + installShared = install True + + copyModuleFiles ext = + findModuleFiles [builtDir] [ext] (libModules lib) + >>= installOrdinaryFiles verbosity targetDir + + cid = compilerId (compiler lbi) + libNames = componentLibraries clbi + vanillaLibNames = map mkLibName libNames + profileLibNames = map mkProfLibName libNames + ghciLibNames = map Internal.mkGHCiLibName libNames + sharedLibNames = map (mkSharedLibName cid) libNames + + hasLib = not $ null (libModules lib) + && null (cSources (libBuildInfo lib)) + whenVanilla = when (hasLib && withVanillaLib lbi) + whenProf = when (hasLib && withProfLib lbi) + whenGHCi = when (hasLib && withGHCiLib lbi) + whenShared = when (hasLib && withSharedLib lbi) + +-- ----------------------------------------------------------------------------- +-- Registering + +hcPkgInfo :: ProgramConfiguration -> HcPkg.HcPkgInfo +hcPkgInfo conf = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcPkgProg + , HcPkg.noPkgDbStack = v < [6,9] + , HcPkg.noVerboseFlag = v < [6,11] + , HcPkg.flagPackageConf = v < [7,5] + } + where + v = versionBranch ver + Just ghcPkgProg = lookupProgram ghcPkgProgram conf + Just ver = programVersion ghcPkgProg + +registerPackage + :: Verbosity + -> InstalledPackageInfo + -> PackageDescription + -> LocalBuildInfo + -> Bool + -> PackageDBStack + -> IO () +registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = + HcPkg.reregister (hcPkgInfo $ withPrograms lbi) verbosity + packageDbs (Right installedPkgInfo) + +pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath +pkgRoot verbosity lbi = pkgRoot' + where + pkgRoot' GlobalPackageDB = + let Just ghcProg = lookupProgram ghcProgram (withPrograms lbi) + in fmap takeDirectory (getGlobalPackageDB verbosity ghcProg) + pkgRoot' UserPackageDB = do + appDir <- getAppUserDataDirectory "ghc" + let ver = compilerVersion (compiler lbi) + subdir = System.Info.arch ++ '-':System.Info.os ++ '-':showVersion ver + rootDir = appDir subdir + -- We must create the root directory for the user package database if it + -- does not yet exists. Otherwise '${pkgroot}' will resolve to a + -- directory at the time of 'ghc-pkg register', and registration will + -- fail. + createDirectoryIfMissing True rootDir + return rootDir + pkgRoot' (SpecificPackageDB fp) = return (takeDirectory fp) + +-- ----------------------------------------------------------------------------- +-- Utils + +isDynamic :: Compiler -> Bool +isDynamic = Internal.ghcLookupProperty "GHC Dynamic" + +supportsDynamicToo :: Compiler -> Bool +supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too" diff --git a/Distribution/Simple/GHC/IPI641.hs b/Distribution/Simple/GHC/IPI641.hs --- a/Distribution/Simple/GHC/IPI641.hs +++ b/Distribution/Simple/GHC/IPI641.hs @@ -9,12 +9,12 @@ -- module Distribution.Simple.GHC.IPI641 ( - InstalledPackageInfo, + InstalledPackageInfo(..), toCurrent, ) where import qualified Distribution.InstalledPackageInfo as Current -import qualified Distribution.Package as Current hiding (depends) +import qualified Distribution.Package as Current hiding (depends, installedPackageId) import Distribution.Text (display) import Distribution.Simple.GHC.IPI642 @@ -65,9 +65,13 @@ mkInstalledPackageId = Current.InstalledPackageId . display toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo -toCurrent ipi@InstalledPackageInfo{} = Current.InstalledPackageInfo { +toCurrent ipi@InstalledPackageInfo{} = + let pid = convertPackageId (package ipi) + mkExposedModule m = Current.ExposedModule m Nothing Nothing + in Current.InstalledPackageInfo { Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)), - Current.sourcePackageId = convertPackageId (package ipi), + Current.sourcePackageId = pid, + Current.packageKey = Current.OldPackageKey pid, Current.license = convertLicense (license ipi), Current.copyright = copyright ipi, Current.maintainer = maintainer ipi, @@ -79,22 +83,24 @@ Current.description = description ipi, Current.category = category ipi, Current.exposed = exposed ipi, - Current.exposedModules = map convertModuleName (exposedModules ipi), + Current.exposedModules = map (mkExposedModule . convertModuleName) (exposedModules ipi), + Current.instantiatedWith = [], Current.hiddenModules = map convertModuleName (hiddenModules ipi), Current.trusted = Current.trusted Current.emptyInstalledPackageInfo, Current.importDirs = importDirs ipi, Current.libraryDirs = libraryDirs ipi, + Current.dataDir = "", Current.hsLibraries = hsLibraries ipi, Current.extraLibraries = extraLibraries ipi, Current.extraGHCiLibraries = [], Current.includeDirs = includeDirs ipi, Current.includes = includes ipi, Current.depends = map (mkInstalledPackageId.convertPackageId) (depends ipi), - Current.hugsOptions = hugsOptions ipi, Current.ccOptions = ccOptions ipi, Current.ldOptions = ldOptions ipi, Current.frameworkDirs = frameworkDirs ipi, Current.frameworks = frameworks ipi, Current.haddockInterfaces = haddockInterfaces ipi, - Current.haddockHTMLs = haddockHTMLs ipi + Current.haddockHTMLs = haddockHTMLs ipi, + Current.pkgRoot = Nothing } diff --git a/Distribution/Simple/GHC/IPI642.hs b/Distribution/Simple/GHC/IPI642.hs --- a/Distribution/Simple/GHC/IPI642.hs +++ b/Distribution/Simple/GHC/IPI642.hs @@ -9,7 +9,7 @@ -- module Distribution.Simple.GHC.IPI642 ( - InstalledPackageInfo, + InstalledPackageInfo(..), toCurrent, -- Don't use these, they're only for conversion purposes @@ -19,7 +19,7 @@ ) where import qualified Distribution.InstalledPackageInfo as Current -import qualified Distribution.Package as Current hiding (depends) +import qualified Distribution.Package as Current hiding (depends, installedPackageId) import qualified Distribution.License as Current import Distribution.Version (Version) @@ -100,9 +100,13 @@ convertLicense OtherLicense = Current.OtherLicense toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo -toCurrent ipi@InstalledPackageInfo{} = Current.InstalledPackageInfo { +toCurrent ipi@InstalledPackageInfo{} = + let pid = convertPackageId (package ipi) + mkExposedModule m = Current.ExposedModule m Nothing Nothing + in Current.InstalledPackageInfo { Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)), - Current.sourcePackageId = convertPackageId (package ipi), + Current.sourcePackageId = pid, + Current.packageKey = Current.OldPackageKey pid, Current.license = convertLicense (license ipi), Current.copyright = copyright ipi, Current.maintainer = maintainer ipi, @@ -114,22 +118,24 @@ Current.description = description ipi, Current.category = category ipi, Current.exposed = exposed ipi, - Current.exposedModules = map convertModuleName (exposedModules ipi), + Current.exposedModules = map (mkExposedModule . convertModuleName) (exposedModules ipi), Current.hiddenModules = map convertModuleName (hiddenModules ipi), + Current.instantiatedWith = [], Current.trusted = Current.trusted Current.emptyInstalledPackageInfo, Current.importDirs = importDirs ipi, Current.libraryDirs = libraryDirs ipi, + Current.dataDir = "", Current.hsLibraries = hsLibraries ipi, Current.extraLibraries = extraLibraries ipi, Current.extraGHCiLibraries = extraGHCiLibraries ipi, Current.includeDirs = includeDirs ipi, Current.includes = includes ipi, Current.depends = map (mkInstalledPackageId.convertPackageId) (depends ipi), - Current.hugsOptions = hugsOptions ipi, Current.ccOptions = ccOptions ipi, Current.ldOptions = ldOptions ipi, Current.frameworkDirs = frameworkDirs ipi, Current.frameworks = frameworks ipi, Current.haddockInterfaces = haddockInterfaces ipi, - Current.haddockHTMLs = haddockHTMLs ipi + Current.haddockHTMLs = haddockHTMLs ipi, + Current.pkgRoot = Nothing } diff --git a/Distribution/Simple/GHC/ImplInfo.hs b/Distribution/Simple/GHC/ImplInfo.hs new file mode 100644 --- /dev/null +++ b/Distribution/Simple/GHC/ImplInfo.hs @@ -0,0 +1,108 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.GHC.ImplInfo +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- This module contains the data structure describing invocation +-- details for a GHC or GHC-derived compiler, such as supported flags +-- and workarounds for bugs. + +module Distribution.Simple.GHC.ImplInfo ( + GhcImplInfo(..), getImplInfo, + ghcVersionImplInfo, ghcjsVersionImplInfo, lhcVersionImplInfo + ) where + +import Distribution.Simple.Compiler + ( Compiler(..), CompilerId(..), CompilerFlavor(..) + , compilerFlavor, compilerVersion, compilerCompatVersion ) +import Distribution.Version ( Version(..) ) + +{- | + Information about features and quirks of a GHC-based implementation. + + Compiler flavors based on GHC behave similarly enough that some of + the support code for them is shared. Every implementation has its + own peculiarities, that may or may not be a direct result of the + underlying GHC version. This record keeps track of these differences. + + All shared code (i.e. everything not in the Distribution.Simple.FLAVOR + module) should use implementation info rather than version numbers + to test for supported features. +-} + +data GhcImplInfo = GhcImplInfo + { hasCcOdirBug :: Bool -- ^ bug in -odir handling for C compilations. + , flagInfoLanguages :: Bool -- ^ --info and --supported-languages flags + , fakeRecordPuns :: Bool -- ^ use -XRecordPuns for NamedFieldPuns + , flagStubdir :: Bool -- ^ -stubdir flag supported + , flagOutputDir :: Bool -- ^ -outputdir flag supported + , noExtInSplitSuffix :: Bool -- ^ split-obj suffix does not contain p_o ext + , flagFfiIncludes :: Bool -- ^ -#include on command line for FFI includes + , flagBuildingCabalPkg :: Bool -- ^ -fbuilding-cabal-package flag supported + , flagPackageId :: Bool -- ^ -package-id / -package flags supported + , separateGccMingw :: Bool -- ^ mingw and gcc are in separate directories + , supportsHaskell2010 :: Bool -- ^ -XHaskell2010 and -XHaskell98 flags + , reportsNoExt :: Bool -- ^ --supported-languages gives Ext and NoExt + , alwaysNondecIndent :: Bool -- ^ NondecreasingIndentation is always on + , flagGhciScript :: Bool -- ^ -ghci-script flag supported + , flagPackageConf :: Bool -- ^ use package-conf instead of package-db + , flagDebugInfo :: Bool -- ^ -g flag supported + } + +getImplInfo :: Compiler -> GhcImplInfo +getImplInfo comp = + case compilerFlavor comp of + GHC -> ghcVersionImplInfo (compilerVersion comp) + LHC -> lhcVersionImplInfo (compilerVersion comp) + GHCJS -> case compilerCompatVersion GHC comp of + Just ghcVer -> ghcjsVersionImplInfo (compilerVersion comp) ghcVer + _ -> error ("Distribution.Simple.GHC.Props.getImplProps: " ++ + "could not find GHC version for GHCJS compiler") + x -> error ("Distribution.Simple.GHC.Props.getImplProps only works" ++ + "for GHC-like compilers (GHC, GHCJS, LHC)" ++ + ", but found " ++ show x) + +ghcVersionImplInfo :: Version -> GhcImplInfo +ghcVersionImplInfo (Version v _) = GhcImplInfo + { hasCcOdirBug = v < [6,4,1] + , flagInfoLanguages = v >= [6,7] + , fakeRecordPuns = v >= [6,8] && v < [6,10] + , flagStubdir = v >= [6,8] + , flagOutputDir = v >= [6,10] + , noExtInSplitSuffix = v < [6,11] + , flagFfiIncludes = v < [6,11] + , flagBuildingCabalPkg = v >= [6,11] + , flagPackageId = v > [6,11] + , separateGccMingw = v < [6,12] + , supportsHaskell2010 = v >= [7] + , reportsNoExt = v >= [7] + , alwaysNondecIndent = v < [7,1] + , flagGhciScript = v >= [7,2] + , flagPackageConf = v < [7,5] + , flagDebugInfo = v >= [7,10] + } + +ghcjsVersionImplInfo :: Version -> Version -> GhcImplInfo +ghcjsVersionImplInfo _ghcjsVer _ghcVer = GhcImplInfo + { hasCcOdirBug = False + , flagInfoLanguages = True + , fakeRecordPuns = False + , flagStubdir = True + , flagOutputDir = True + , noExtInSplitSuffix = False + , flagFfiIncludes = False + , flagBuildingCabalPkg = True + , flagPackageId = True + , separateGccMingw = False + , supportsHaskell2010 = True + , reportsNoExt = True + , alwaysNondecIndent = False + , flagGhciScript = True + , flagPackageConf = False + , flagDebugInfo = False + } + +lhcVersionImplInfo :: Version -> GhcImplInfo +lhcVersionImplInfo = ghcVersionImplInfo diff --git a/Distribution/Simple/GHC/Internal.hs b/Distribution/Simple/GHC/Internal.hs new file mode 100644 --- /dev/null +++ b/Distribution/Simple/GHC/Internal.hs @@ -0,0 +1,489 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Simple.GHC.Internal +-- Copyright : Isaac Jones 2003-2007 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- This module contains functions shared by GHC (Distribution.Simple.GHC) +-- and GHC-derived compilers. + +module Distribution.Simple.GHC.Internal ( + configureToolchain, + getLanguages, + getExtensions, + targetPlatform, + getGhcInfo, + componentCcGhcOptions, + componentGhcOptions, + mkGHCiLibName, + filterGhciFlags, + ghcLookupProperty, + getHaskellObjects, + mkGhcOptPackages, + substTopDir, + checkPackageDbEnvVar + ) where + +import Distribution.Simple.GHC.ImplInfo ( GhcImplInfo (..) ) +import Distribution.Package + ( InstalledPackageId, PackageId ) +import Distribution.InstalledPackageInfo + ( InstalledPackageInfo ) +import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo + ( InstalledPackageInfo_(..) ) +import Distribution.PackageDescription as PD + ( BuildInfo(..), Library(..), libModules + , hcOptions, usedExtensions, ModuleRenaming, lookupRenaming ) +import Distribution.Compat.Exception ( catchExit, catchIO ) +import Distribution.Simple.Compiler + ( CompilerFlavor(..), Compiler(..), DebugInfoLevel(..), OptimisationLevel(..) ) +import Distribution.Simple.Program.GHC +import Distribution.Simple.Setup + ( toFlag ) +import qualified Distribution.ModuleName as ModuleName +import Distribution.Simple.Program + ( Program(..), ConfiguredProgram(..), ProgramConfiguration + , ProgramLocation(..), ProgramSearchPath, ProgramSearchPathEntry(..) + , rawSystemProgram, rawSystemProgramStdout, programPath + , addKnownProgram, arProgram, ldProgram, gccProgram, stripProgram + , getProgramOutput ) +import Distribution.Simple.Program.Types ( suppressOverrideArgs ) +import Distribution.Simple.LocalBuildInfo + ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) + , LibraryName(..) ) +import Distribution.Simple.Utils +import Distribution.Simple.BuildPaths +import Distribution.System ( buildOS, OS(..), Platform, platformFromTriple ) +import Distribution.Text ( display, simpleParse ) +import Distribution.Utils.NubList ( toNubListR ) +import Distribution.Verbosity +import Language.Haskell.Extension + ( Language(..), Extension(..), KnownExtension(..) ) + +import qualified Data.Map as M +import Data.Char ( isSpace ) +import Data.Maybe ( fromMaybe, maybeToList, isJust ) +import Control.Monad ( unless, when ) +import Data.Monoid ( Monoid(..) ) +import System.Directory ( getDirectoryContents, getTemporaryDirectory ) +import System.Environment ( getEnv ) +import System.FilePath ( (), (<.>), takeExtension, takeDirectory ) +import System.IO ( hClose, hPutStrLn ) + +targetPlatform :: [(String, String)] -> Maybe Platform +targetPlatform ghcInfo = platformFromTriple =<< lookup "Target platform" ghcInfo + +-- | Adjust the way we find and configure gcc and ld +-- +configureToolchain :: GhcImplInfo + -> ConfiguredProgram + -> M.Map String String + -> ProgramConfiguration + -> ProgramConfiguration +configureToolchain implInfo ghcProg ghcInfo = + addKnownProgram gccProgram { + programFindLocation = findProg gccProgram extraGccPath, + programPostConf = configureGcc + } + . addKnownProgram ldProgram { + programFindLocation = findProg ldProgram extraLdPath, + programPostConf = configureLd + } + . addKnownProgram arProgram { + programFindLocation = findProg arProgram extraArPath + } + . addKnownProgram stripProgram { + programFindLocation = findProg stripProgram extraStripPath + } + where + compilerDir = takeDirectory (programPath ghcProg) + baseDir = takeDirectory compilerDir + mingwBinDir = baseDir "mingw" "bin" + libDir = baseDir "gcc-lib" + includeDir = baseDir "include" "mingw" + isWindows = case buildOS of Windows -> True; _ -> False + binPrefix = "" + + mkExtraPath :: Maybe FilePath -> FilePath -> [FilePath] + mkExtraPath mbPath mingwPath | isWindows = mbDir ++ [mingwPath] + | otherwise = mbDir + where + mbDir = maybeToList . fmap takeDirectory $ mbPath + + extraGccPath = mkExtraPath mbGccLocation windowsExtraGccDir + 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, windowsExtraLdDir, + windowsExtraArDir, windowsExtraStripDir) + | separateGccMingw implInfo = (baseDir, libDir, libDir, libDir) + | otherwise = -- GHC >= 6.12 + let b = mingwBinDir binPrefix + in (b, b, b, b) + + findProg :: Program -> [FilePath] + -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath) + findProg prog extraPath v searchpath = + programFindLocation prog v searchpath' + where + searchpath' = (map ProgramSearchPathDir extraPath) ++ searchpath + + -- Read tool locations from the 'ghc --info' output. Useful when + -- cross-compiling. + mbGccLocation = M.lookup "C compiler command" ghcInfo + mbLdLocation = M.lookup "ld command" ghcInfo + mbArLocation = M.lookup "ar command" ghcInfo + mbStripLocation = M.lookup "strip command" ghcInfo + + ccFlags = getFlags "C compiler flags" + gccLinkerFlags = getFlags "Gcc Linker flags" + ldLinkerFlags = getFlags "Ld Linker flags" + + getFlags key = case M.lookup key ghcInfo of + Nothing -> [] + Just flags -> + case reads flags of + [(args, "")] -> args + _ -> [] -- XXX Should should be an error really + + configureGcc :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram + configureGcc v gccProg = do + gccProg' <- configureGcc' v gccProg + return gccProg' { + programDefaultArgs = programDefaultArgs gccProg' + ++ ccFlags ++ gccLinkerFlags + } + + configureGcc' :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram + configureGcc' + | isWindows = \_ gccProg -> case programLocation gccProg of + -- if it's found on system then it means we're using the result + -- of programFindLocation above rather than a user-supplied path + -- Pre GHC 6.12, that meant we should add these flags to tell + -- ghc's gcc where it lives and thus where gcc can find its + -- various files: + FoundOnSystem {} + | separateGccMingw implInfo -> + return gccProg { programDefaultArgs = ["-B" ++ libDir, + "-I" ++ includeDir] } + _ -> return gccProg + | otherwise = \_ gccProg -> return gccProg + + configureLd :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram + configureLd v ldProg = do + ldProg' <- configureLd' v ldProg + return ldProg' { + programDefaultArgs = programDefaultArgs ldProg' ++ ldLinkerFlags + } + + -- 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 + hPutStrLn testchnd "int foo() { return 0; }" + hClose testchnd; hClose testohnd + rawSystemProgram verbosity ghcProg ["-c", testcfile, + "-o", testofile] + withTempFile tempDir ".o" $ \testofile' testohnd' -> + do + hClose testohnd' + _ <- rawSystemProgramStdout verbosity ldProg + ["-x", "-r", testofile, "-o", testofile'] + return True + `catchIO` (\_ -> return False) + `catchExit` (\_ -> return False) + if ldx + then return ldProg { programDefaultArgs = ["-x"] } + else return ldProg + +getLanguages :: Verbosity -> GhcImplInfo -> ConfiguredProgram + -> IO [(Language, String)] +getLanguages _ implInfo _ + -- TODO: should be using --supported-languages rather than hard coding + | supportsHaskell2010 implInfo = return [(Haskell98, "-XHaskell98") + ,(Haskell2010, "-XHaskell2010")] + | otherwise = return [(Haskell98, "")] + +getGhcInfo :: Verbosity -> GhcImplInfo -> ConfiguredProgram + -> IO [(String, String)] +getGhcInfo verbosity implInfo ghcProg + | flagInfoLanguages implInfo = do + xs <- getProgramOutput verbosity (suppressOverrideArgs ghcProg) + ["--info"] + case reads xs of + [(i, ss)] + | all isSpace ss -> + return i + _ -> + die "Can't parse --info output of GHC" + | otherwise = + return [] + +getExtensions :: Verbosity -> GhcImplInfo -> ConfiguredProgram + -> IO [(Extension, String)] +getExtensions verbosity implInfo ghcProg + | flagInfoLanguages implInfo = do + str <- getProgramOutput verbosity (suppressOverrideArgs ghcProg) + ["--supported-languages"] + let extStrs = if reportsNoExt implInfo + then lines str + else -- Older GHCs only gave us either Foo or NoFoo, + -- so we have to work out the other one ourselves + [ extStr'' + | extStr <- lines str + , let extStr' = case extStr of + 'N' : 'o' : xs -> xs + _ -> "No" ++ extStr + , extStr'' <- [extStr, extStr'] + ] + let extensions0 = [ (ext, "-X" ++ display ext) + | Just ext <- map simpleParse extStrs ] + extensions1 = if fakeRecordPuns implInfo + then -- ghc-6.8 introduced RecordPuns however it + -- should have been NamedFieldPuns. We now + -- encourage packages to use NamedFieldPuns + -- so for compatibility we fake support for + -- it in ghc-6.8 by making it an alias for + -- the old RecordPuns extension. + (EnableExtension NamedFieldPuns, "-XRecordPuns") : + (DisableExtension NamedFieldPuns, "-XNoRecordPuns") : + extensions0 + else extensions0 + extensions2 = if alwaysNondecIndent implInfo + then -- ghc-7.2 split NondecreasingIndentation off + -- into a proper extension. Before that it + -- was always on. + (EnableExtension NondecreasingIndentation, "") : + (DisableExtension NondecreasingIndentation, "") : + extensions1 + else extensions1 + return extensions2 + + | otherwise = return oldLanguageExtensions + +-- | For GHC 6.6.x and earlier, the mapping from supported extensions to flags +oldLanguageExtensions :: [(Extension, String)] +oldLanguageExtensions = + let doFlag (f, (enable, disable)) = [(EnableExtension f, enable), + (DisableExtension f, disable)] + fglasgowExts = ("-fglasgow-exts", + "") -- This is wrong, but we don't want to turn + -- all the extensions off when asked to just + -- turn one off + fFlag flag = ("-f" ++ flag, "-fno-" ++ flag) + in concatMap doFlag + [(OverlappingInstances , fFlag "allow-overlapping-instances") + ,(TypeSynonymInstances , fglasgowExts) + ,(TemplateHaskell , fFlag "th") + ,(ForeignFunctionInterface , fFlag "ffi") + ,(MonomorphismRestriction , fFlag "monomorphism-restriction") + ,(MonoPatBinds , fFlag "mono-pat-binds") + ,(UndecidableInstances , fFlag "allow-undecidable-instances") + ,(IncoherentInstances , fFlag "allow-incoherent-instances") + ,(Arrows , fFlag "arrows") + ,(Generics , fFlag "generics") + ,(ImplicitPrelude , fFlag "implicit-prelude") + ,(ImplicitParams , fFlag "implicit-params") + ,(CPP , ("-cpp", ""{- Wrong -})) + ,(BangPatterns , fFlag "bang-patterns") + ,(KindSignatures , fglasgowExts) + ,(RecursiveDo , fglasgowExts) + ,(ParallelListComp , fglasgowExts) + ,(MultiParamTypeClasses , fglasgowExts) + ,(FunctionalDependencies , fglasgowExts) + ,(Rank2Types , fglasgowExts) + ,(RankNTypes , fglasgowExts) + ,(PolymorphicComponents , fglasgowExts) + ,(ExistentialQuantification , fglasgowExts) + ,(ScopedTypeVariables , fFlag "scoped-type-variables") + ,(FlexibleContexts , fglasgowExts) + ,(FlexibleInstances , fglasgowExts) + ,(EmptyDataDecls , fglasgowExts) + ,(PatternGuards , fglasgowExts) + ,(GeneralizedNewtypeDeriving , fglasgowExts) + ,(MagicHash , fglasgowExts) + ,(UnicodeSyntax , fglasgowExts) + ,(PatternSignatures , fglasgowExts) + ,(UnliftedFFITypes , fglasgowExts) + ,(LiberalTypeSynonyms , fglasgowExts) + ,(TypeOperators , fglasgowExts) + ,(GADTs , fglasgowExts) + ,(RelaxedPolyRec , fglasgowExts) + ,(ExtendedDefaultRules , fFlag "extended-default-rules") + ,(UnboxedTuples , fglasgowExts) + ,(DeriveDataTypeable , fglasgowExts) + ,(ConstrainedClassMethods , fglasgowExts) + ] + +componentCcGhcOptions :: Verbosity -> GhcImplInfo -> LocalBuildInfo + -> BuildInfo -> ComponentLocalBuildInfo + -> FilePath -> FilePath + -> GhcOptions +componentCcGhcOptions verbosity implInfo lbi bi clbi pref filename = + mempty { + ghcOptVerbosity = toFlag verbosity, + ghcOptMode = toFlag GhcModeCompile, + ghcOptInputFiles = toNubListR [filename], + + ghcOptCppIncludePath = toNubListR $ [autogenModulesDir lbi, odir] + ++ PD.includeDirs bi, + ghcOptPackageDBs = withPackageDB lbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptCcOptions = toNubListR $ + (case withOptimization lbi of + NoOptimisation -> [] + _ -> ["-O2"]) ++ + (case withDebugInfo lbi of + NoDebugInfo -> [] + MinimalDebugInfo -> ["-g1"] + NormalDebugInfo -> ["-g"] + MaximalDebugInfo -> ["-g3"]) ++ + PD.ccOptions bi, + ghcOptObjDir = toFlag odir + } + where + odir | hasCcOdirBug implInfo = pref takeDirectory filename + | otherwise = pref + -- ghc 6.4.0 had a bug in -odir handling for C compilations. + +componentGhcOptions :: Verbosity -> LocalBuildInfo + -> BuildInfo -> ComponentLocalBuildInfo -> FilePath + -> GhcOptions +componentGhcOptions verbosity lbi bi clbi odir = + mempty { + ghcOptVerbosity = toFlag verbosity, + ghcOptHideAllPackages = toFlag True, + ghcOptCabal = toFlag True, + ghcOptPackageDBs = withPackageDB lbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptSplitObjs = toFlag (splitObjs lbi), + ghcOptSourcePathClear = toFlag True, + ghcOptSourcePath = toNubListR $ [odir] ++ (hsSourceDirs bi) + ++ [autogenModulesDir lbi], + ghcOptCppIncludePath = toNubListR $ [autogenModulesDir lbi, odir] + ++ PD.includeDirs bi, + ghcOptCppOptions = toNubListR $ cppOptions bi, + ghcOptCppIncludes = toNubListR $ + [autogenModulesDir lbi cppHeaderName], + ghcOptFfiIncludes = toNubListR $ PD.includes bi, + ghcOptObjDir = toFlag odir, + ghcOptHiDir = toFlag odir, + ghcOptStubDir = toFlag odir, + ghcOptOutputDir = toFlag odir, + ghcOptOptimisation = toGhcOptimisation (withOptimization lbi), + ghcOptDebugInfo = toGhcDebugInfo (withDebugInfo lbi), + ghcOptExtra = toNubListR $ hcOptions GHC bi, + ghcOptLanguage = toFlag (fromMaybe Haskell98 (defaultLanguage bi)), + -- Unsupported extensions have already been checked by configure + ghcOptExtensions = toNubListR $ usedExtensions bi, + ghcOptExtensionMap = M.fromList . compilerExtensions $ (compiler lbi) + } + where + toGhcOptimisation NoOptimisation = mempty --TODO perhaps override? + toGhcOptimisation NormalOptimisation = toFlag GhcNormalOptimisation + toGhcOptimisation MaximumOptimisation = toFlag GhcMaximumOptimisation + + -- GHC doesn't support debug info levels yet. + toGhcDebugInfo NoDebugInfo = mempty + toGhcDebugInfo MinimalDebugInfo = toFlag True + toGhcDebugInfo NormalDebugInfo = toFlag True + toGhcDebugInfo MaximalDebugInfo = toFlag True + +-- | Strip out flags that are not supported in ghci +filterGhciFlags :: [String] -> [String] +filterGhciFlags = filter supported + where + supported ('-':'O':_) = False + supported "-debug" = False + supported "-threaded" = False + supported "-ticky" = False + supported "-eventlog" = False + supported "-prof" = False + supported "-unreg" = False + supported _ = True + +mkGHCiLibName :: LibraryName -> String +mkGHCiLibName (LibraryName lib) = lib <.> "o" + +ghcLookupProperty :: String -> Compiler -> Bool +ghcLookupProperty prop comp = + case M.lookup prop (compilerProperties comp) of + Just "YES" -> True + _ -> False + +-- when using -split-objs, we need to search for object files in the +-- Module_split directory for each module. +getHaskellObjects :: GhcImplInfo -> Library -> LocalBuildInfo + -> FilePath -> String -> Bool -> IO [FilePath] +getHaskellObjects implInfo lib lbi pref wanted_obj_ext allow_split_objs + | splitObjs lbi && allow_split_objs = do + let splitSuffix = if noExtInSplitSuffix implInfo + then "_split" + else "_" ++ wanted_obj_ext ++ "_split" + dirs = [ pref (ModuleName.toFilePath x ++ splitSuffix) + | x <- libModules lib ] + objss <- mapM getDirectoryContents dirs + let objs = [ dir obj + | (objs',dir) <- zip objss dirs, obj <- objs', + let obj_ext = takeExtension obj, + '.':wanted_obj_ext == obj_ext ] + return objs + | otherwise = + return [ pref ModuleName.toFilePath x <.> wanted_obj_ext + | x <- libModules lib ] + +mkGhcOptPackages :: ComponentLocalBuildInfo + -> [(InstalledPackageId, PackageId, ModuleRenaming)] +mkGhcOptPackages clbi = + map (\(i,p) -> (i,p,lookupRenaming p (componentPackageRenaming clbi))) + (componentPackageDeps clbi) + +substTopDir :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo +substTopDir topDir ipo + = ipo { + InstalledPackageInfo.importDirs + = map f (InstalledPackageInfo.importDirs ipo), + InstalledPackageInfo.libraryDirs + = map f (InstalledPackageInfo.libraryDirs ipo), + InstalledPackageInfo.includeDirs + = map f (InstalledPackageInfo.includeDirs ipo), + InstalledPackageInfo.frameworkDirs + = map f (InstalledPackageInfo.frameworkDirs ipo), + InstalledPackageInfo.haddockInterfaces + = map f (InstalledPackageInfo.haddockInterfaces ipo), + InstalledPackageInfo.haddockHTMLs + = map f (InstalledPackageInfo.haddockHTMLs ipo) + } + where f ('$':'t':'o':'p':'d':'i':'r':rest) = topDir ++ rest + f x = x + +-- Cabal does not use the environment variable GHC{,JS}_PACKAGE_PATH; let +-- users know that this is the case. See ticket #335. Simply ignoring it is +-- not a good idea, since then ghc and cabal are looking at different sets +-- of package DBs and chaos is likely to ensue. +-- +-- An exception to this is when running cabal from within a `cabal exec` +-- environment. In this case, `cabal exec` will set the +-- CABAL_SANDBOX_PACKAGE_PATH to the same value that it set +-- GHC{,JS}_PACKAGE_PATH to. If that is the case it is OK to allow +-- GHC{,JS}_PACKAGE_PATH. +checkPackageDbEnvVar :: String -> String -> IO () +checkPackageDbEnvVar compilerName packagePathEnvVar = do + mPP <- lookupEnv packagePathEnvVar + when (isJust mPP) $ do + mcsPP <- lookupEnv "CABAL_SANDBOX_PACKAGE_PATH" + unless (mPP == mcsPP) abort + where + lookupEnv :: String -> IO (Maybe String) + lookupEnv name = (Just `fmap` getEnv name) `catchIO` const (return Nothing) + abort = + die $ "Use of " ++ compilerName ++ "'s environment variable " + ++ packagePathEnvVar ++ " is incompatible with Cabal. Use the " + ++ "flag --package-db to specify a package database (it can be " + ++ "used multiple times)." diff --git a/Distribution/Simple/GHCJS.hs b/Distribution/Simple/GHCJS.hs new file mode 100644 --- /dev/null +++ b/Distribution/Simple/GHCJS.hs @@ -0,0 +1,898 @@ +module Distribution.Simple.GHCJS ( + configure, getInstalledPackages, getPackageDBContents, + buildLib, buildExe, + replLib, replExe, + startInterpreter, + installLib, installExe, + libAbiHash, + hcPkgInfo, + registerPackage, + componentGhcOptions, + getLibDir, + isDynamic, + getGlobalPackageDB, + runCmd + ) where + +import Distribution.Simple.GHC.ImplInfo ( getImplInfo, ghcjsVersionImplInfo ) +import qualified Distribution.Simple.GHC.Internal as Internal +import Distribution.PackageDescription as PD + ( PackageDescription(..), BuildInfo(..), Executable(..) + , Library(..), libModules, exeModules + , hcOptions, hcProfOptions, hcSharedOptions + , allExtensions ) +import Distribution.InstalledPackageInfo + ( InstalledPackageInfo ) +import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo + ( InstalledPackageInfo_(..) ) +import Distribution.Simple.PackageIndex ( InstalledPackageIndex ) +import qualified Distribution.Simple.PackageIndex as PackageIndex +import Distribution.Simple.LocalBuildInfo + ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) + , LibraryName(..) ) +import qualified Distribution.Simple.Hpc as Hpc +import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs ) +import Distribution.Simple.BuildPaths +import Distribution.Simple.Utils +import Distribution.Simple.Program + ( Program(..), ConfiguredProgram(..), ProgramConfiguration + , ProgramSearchPath + , rawSystemProgramConf + , rawSystemProgramStdout, rawSystemProgramStdoutConf + , getProgramInvocationOutput + , requireProgramVersion, requireProgram + , userMaybeSpecifyPath, programPath + , lookupProgram, addKnownPrograms + , ghcjsProgram, ghcjsPkgProgram, c2hsProgram, hsc2hsProgram + , ldProgram, haddockProgram, stripProgram ) +import qualified Distribution.Simple.Program.HcPkg as HcPkg +import qualified Distribution.Simple.Program.Ar as Ar +import qualified Distribution.Simple.Program.Ld as Ld +import qualified Distribution.Simple.Program.Strip as Strip +import Distribution.Simple.Program.GHC +import Distribution.Simple.Setup + ( toFlag, fromFlag, configCoverage, configDistPref ) +import qualified Distribution.Simple.Setup as Cabal + ( Flag(..) ) +import Distribution.Simple.Compiler + ( CompilerFlavor(..), CompilerId(..), Compiler(..) + , PackageDB(..), PackageDBStack, AbiTag(..) ) +import Distribution.Version + ( Version(..), anyVersion, orLaterVersion ) +import Distribution.System + ( Platform(..) ) +import Distribution.Verbosity +import Distribution.Utils.NubList + ( overNubListR, toNubListR ) +import Distribution.Text ( display ) +import Language.Haskell.Extension ( Extension(..) + , KnownExtension(..)) + +import Control.Monad ( unless, when ) +import Data.Char ( isSpace ) +import qualified Data.Map as M ( fromList ) +import Data.Monoid ( Monoid(..) ) +import System.Directory ( doesFileExist ) +import System.FilePath ( (), (<.>), takeExtension, + takeDirectory, replaceExtension, + splitExtension ) +import Distribution.Compat.Exception (catchIO) + +configure :: Verbosity -> Maybe FilePath -> Maybe FilePath + -> ProgramConfiguration + -> IO (Compiler, Maybe Platform, ProgramConfiguration) +configure verbosity hcPath hcPkgPath conf0 = do + (ghcjsProg, ghcjsVersion, conf1) <- + requireProgramVersion verbosity ghcjsProgram + (orLaterVersion (Version [0,1] [])) + (userMaybeSpecifyPath "ghcjs" hcPath conf0) + Just ghcjsGhcVersion <- findGhcjsGhcVersion verbosity (programPath ghcjsProg) + let implInfo = ghcjsVersionImplInfo ghcjsVersion ghcjsGhcVersion + + -- This is slightly tricky, we have to configure ghcjs first, then we use the + -- location of ghcjs to help find ghcjs-pkg in the case that the user did not + -- specify the location of ghc-pkg directly: + (ghcjsPkgProg, ghcjsPkgVersion, conf2) <- + requireProgramVersion verbosity ghcjsPkgProgram { + programFindLocation = guessGhcjsPkgFromGhcjsPath ghcjsProg + } + anyVersion (userMaybeSpecifyPath "ghcjs-pkg" hcPkgPath conf1) + + Just ghcjsPkgGhcVersion <- findGhcjsPkgGhcVersion + verbosity (programPath ghcjsPkgProg) + + when (ghcjsVersion /= ghcjsPkgVersion) $ die $ + "Version mismatch between ghcjs and ghcjs-pkg: " + ++ programPath ghcjsProg ++ " is version " ++ display ghcjsVersion ++ " " + ++ programPath ghcjsPkgProg ++ " is version " ++ display ghcjsPkgVersion + + when (ghcjsGhcVersion /= ghcjsPkgGhcVersion) $ die $ + "Version mismatch between ghcjs and ghcjs-pkg: " + ++ programPath ghcjsProg + ++ " was built with GHC version " ++ display ghcjsGhcVersion ++ " " + ++ programPath ghcjsPkgProg + ++ " was built with GHC version " ++ display ghcjsPkgGhcVersion + + -- be sure to use our versions of hsc2hs, c2hs, haddock and ghc + let hsc2hsProgram' = + hsc2hsProgram { programFindLocation = + guessHsc2hsFromGhcjsPath ghcjsProg } + c2hsProgram' = + c2hsProgram { programFindLocation = + guessC2hsFromGhcjsPath ghcjsProg } + + haddockProgram' = + haddockProgram { programFindLocation = + guessHaddockFromGhcjsPath ghcjsProg } + conf3 = addKnownPrograms [ hsc2hsProgram', c2hsProgram', haddockProgram' ] conf2 + + languages <- Internal.getLanguages verbosity implInfo ghcjsProg + extensions <- Internal.getExtensions verbosity implInfo ghcjsProg + + ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcjsProg + let ghcInfoMap = M.fromList ghcInfo + + let comp = Compiler { + compilerId = CompilerId GHCJS ghcjsVersion, + compilerAbiTag = AbiTag $ + "ghc" ++ intercalate "_" (map show . versionBranch $ ghcjsGhcVersion), + compilerCompat = [CompilerId GHC ghcjsGhcVersion], + compilerLanguages = languages, + compilerExtensions = extensions, + compilerProperties = ghcInfoMap + } + compPlatform = Internal.targetPlatform ghcInfo + -- configure gcc and ld + let conf4 = if ghcjsNativeToo comp + then Internal.configureToolchain implInfo + ghcjsProg ghcInfoMap conf3 + else conf3 + return (comp, compPlatform, conf4) + +ghcjsNativeToo :: Compiler -> Bool +ghcjsNativeToo = Internal.ghcLookupProperty "Native Too" + +guessGhcjsPkgFromGhcjsPath :: ConfiguredProgram -> Verbosity + -> ProgramSearchPath -> IO (Maybe FilePath) +guessGhcjsPkgFromGhcjsPath = guessToolFromGhcjsPath ghcjsPkgProgram + +guessHsc2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity + -> ProgramSearchPath -> IO (Maybe FilePath) +guessHsc2hsFromGhcjsPath = guessToolFromGhcjsPath hsc2hsProgram + +guessC2hsFromGhcjsPath :: ConfiguredProgram -> Verbosity + -> ProgramSearchPath -> IO (Maybe FilePath) +guessC2hsFromGhcjsPath = guessToolFromGhcjsPath c2hsProgram + +guessHaddockFromGhcjsPath :: ConfiguredProgram -> Verbosity + -> ProgramSearchPath -> IO (Maybe FilePath) +guessHaddockFromGhcjsPath = guessToolFromGhcjsPath haddockProgram + +guessToolFromGhcjsPath :: Program -> ConfiguredProgram + -> Verbosity -> ProgramSearchPath + -> IO (Maybe FilePath) +guessToolFromGhcjsPath tool ghcjsProg verbosity searchpath + = do let toolname = programName tool + path = programPath ghcjsProg + dir = takeDirectory path + versionSuffix = takeVersionSuffix (dropExeExtension path) + guessNormal = dir toolname <.> exeExtension + guessGhcjsVersioned = dir (toolname ++ "-ghcjs" ++ versionSuffix) + <.> exeExtension + guessGhcjs = dir (toolname ++ "-ghcjs") + <.> exeExtension + guessVersioned = dir (toolname ++ versionSuffix) <.> exeExtension + guesses | null versionSuffix = [guessGhcjs, guessNormal] + | otherwise = [guessGhcjsVersioned, + guessGhcjs, + guessVersioned, + guessNormal] + info verbosity $ "looking for tool " ++ toolname + ++ " near compiler in " ++ dir + exists <- mapM doesFileExist guesses + case [ file | (file, True) <- zip guesses exists ] of + -- If we can't find it near ghc, fall back to the usual + -- method. + [] -> programFindLocation tool verbosity searchpath + (fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp + return (Just fp) + + where takeVersionSuffix :: FilePath -> String + takeVersionSuffix = reverse . takeWhile (`elem ` "0123456789.-") . + reverse + + dropExeExtension :: FilePath -> FilePath + dropExeExtension filepath = + case splitExtension filepath of + (filepath', extension) | extension == exeExtension -> filepath' + | otherwise -> filepath + + +-- | Given a single package DB, return all installed packages. +getPackageDBContents :: Verbosity -> PackageDB -> ProgramConfiguration + -> IO InstalledPackageIndex +getPackageDBContents verbosity packagedb conf = do + pkgss <- getInstalledPackages' verbosity [packagedb] conf + toPackageIndex verbosity pkgss conf + +-- | Given a package DB stack, return all installed packages. +getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration + -> IO InstalledPackageIndex +getInstalledPackages verbosity packagedbs conf = do + checkPackageDbEnvVar + checkPackageDbStack packagedbs + pkgss <- getInstalledPackages' verbosity packagedbs conf + index <- toPackageIndex verbosity pkgss conf + return $! index + +toPackageIndex :: Verbosity + -> [(PackageDB, [InstalledPackageInfo])] + -> ProgramConfiguration + -> IO InstalledPackageIndex +toPackageIndex verbosity pkgss conf = do + -- On Windows, various fields have $topdir/foo rather than full + -- paths. We need to substitute the right value in so that when + -- we, for example, call gcc, we have proper paths to give it. + topDir <- getLibDir' verbosity ghcjsProg + let indices = [ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs) + | (_, pkgs) <- pkgss ] + return $! (mconcat indices) + + where + Just ghcjsProg = lookupProgram ghcjsProgram conf + +checkPackageDbEnvVar :: IO () +checkPackageDbEnvVar = + Internal.checkPackageDbEnvVar "GHCJS" "GHCJS_PACKAGE_PATH" + +checkPackageDbStack :: PackageDBStack -> IO () +checkPackageDbStack (GlobalPackageDB:rest) + | GlobalPackageDB `notElem` rest = return () +checkPackageDbStack rest + | GlobalPackageDB `notElem` rest = + die $ "With current ghc versions the global package db is always used " + ++ "and must be listed first. This ghc limitation may be lifted in " + ++ "future, see http://hackage.haskell.org/trac/ghc/ticket/5977" +checkPackageDbStack _ = + die $ "If the global package db is specified, it must be " + ++ "specified first and cannot be specified multiple times" + +getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramConfiguration + -> IO [(PackageDB, [InstalledPackageInfo])] +getInstalledPackages' verbosity packagedbs conf = + sequence + [ do pkgs <- HcPkg.dump (hcPkgInfo conf) verbosity packagedb + return (packagedb, pkgs) + | packagedb <- packagedbs ] + +getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath +getLibDir verbosity lbi = + (reverse . dropWhile isSpace . reverse) `fmap` + rawSystemProgramStdoutConf verbosity ghcjsProgram + (withPrograms lbi) ["--print-libdir"] + +getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath +getLibDir' verbosity ghcjsProg = + (reverse . dropWhile isSpace . reverse) `fmap` + rawSystemProgramStdout verbosity ghcjsProg ["--print-libdir"] + +-- | Return the 'FilePath' to the global GHC package database. +getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath +getGlobalPackageDB verbosity ghcjsProg = + (reverse . dropWhile isSpace . reverse) `fmap` + rawSystemProgramStdout verbosity ghcjsProg ["--print-global-package-db"] + +toJSLibName :: String -> String +toJSLibName lib + | takeExtension lib `elem` [".dll",".dylib",".so"] + = replaceExtension lib "js_so" + | takeExtension lib == ".a" = replaceExtension lib "js_a" + | otherwise = lib <.> "js_a" + +buildLib, replLib :: Verbosity -> Cabal.Flag (Maybe Int) -> PackageDescription + -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo + -> IO () +buildLib = buildOrReplLib False +replLib = buildOrReplLib True + +buildOrReplLib :: Bool -> Verbosity -> Cabal.Flag (Maybe Int) + -> PackageDescription -> LocalBuildInfo + -> Library -> ComponentLocalBuildInfo -> IO () +buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do + libName <- case componentLibraries clbi of + [libName] -> return libName + [] -> die "No library name found when building library" + _ -> die "Multiple library names found when building library" + let libTargetDir = buildDir lbi + whenVanillaLib forceVanilla = + when (not forRepl && (forceVanilla || withVanillaLib lbi)) + whenProfLib = when (not forRepl && withProfLib lbi) + whenSharedLib forceShared = + when (not forRepl && (forceShared || withSharedLib lbi)) + whenGHCiLib = when (not forRepl && withGHCiLib lbi && withVanillaLib lbi) + ifReplLib = when forRepl + comp = compiler lbi + implInfo = getImplInfo comp + hole_insts = map (\(k,(p,n)) -> (k,(InstalledPackageInfo.packageKey p,n))) + (instantiatedWith lbi) + nativeToo = ghcjsNativeToo comp + + (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi) + let runGhcjsProg = runGHC verbosity ghcjsProg comp + libBi = libBuildInfo lib + isGhcjsDynamic = isDynamic comp + dynamicTooSupported = supportsDynamicToo comp + doingTH = EnableExtension TemplateHaskell `elem` allExtensions libBi + forceVanillaLib = doingTH && not isGhcjsDynamic + forceSharedLib = doingTH && isGhcjsDynamic + -- TH always needs default libs, even when building for profiling + + -- Determine if program coverage should be enabled and if so, what + -- '-hpcdir' should be. + let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi + -- Component name. Not 'libName' because that has the "HS" prefix + -- that GHC gives Haskell libraries. + cname = display $ PD.package $ localPkgDescr lbi + distPref = fromFlag $ configDistPref $ configFlags lbi + hpcdir way + | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way cname + | otherwise = mempty + + createDirectoryIfMissingVerbose verbosity True libTargetDir + -- TODO: do we need to put hs-boot files into place for mutually recursive + -- modules? + let cObjs = map (`replaceExtension` objExtension) (cSources libBi) + jsSrcs = jsSources libBi + baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir + linkJsLibOpts = mempty { + ghcOptExtra = toNubListR $ + [ "-link-js-lib" , (\(LibraryName l) -> l) libName + , "-js-lib-outputdir", libTargetDir ] ++ + concatMap (\x -> ["-js-lib-src",x]) jsSrcs + } + vanillaOptsNoJsLib = baseOpts `mappend` mempty { + ghcOptMode = toFlag GhcModeMake, + ghcOptNumJobs = numJobs, + ghcOptPackageKey = toFlag (pkgKey lbi), + ghcOptSigOf = hole_insts, + ghcOptInputModules = toNubListR $ libModules lib, + ghcOptHPCDir = hpcdir Hpc.Vanilla + } + vanillaOpts = vanillaOptsNoJsLib `mappend` linkJsLibOpts + + profOpts = adjustExts "p_hi" "p_o" vanillaOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptExtra = toNubListR $ + ghcjsProfOptions libBi, + ghcOptHPCDir = hpcdir Hpc.Prof + } + sharedOpts = adjustExts "dyn_hi" "dyn_o" vanillaOpts `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptFPic = toFlag True, + ghcOptExtra = toNubListR $ + ghcjsSharedOptions libBi, + ghcOptHPCDir = hpcdir Hpc.Dyn + } + linkerOpts = mempty { + ghcOptLinkOptions = toNubListR $ PD.ldOptions libBi, + ghcOptLinkLibs = toNubListR $ extraLibs libBi, + ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi, + ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi, + ghcOptInputFiles = + toNubListR $ [libTargetDir x | x <- cObjs] ++ jsSrcs + } + replOpts = vanillaOptsNoJsLib { + ghcOptExtra = overNubListR + Internal.filterGhciFlags + (ghcOptExtra vanillaOpts), + ghcOptNumJobs = mempty + } + `mappend` linkerOpts + `mappend` mempty { + ghcOptMode = toFlag GhcModeInteractive, + ghcOptOptimisation = toFlag GhcNoOptimisation + } + + vanillaSharedOpts = vanillaOpts `mappend` + mempty { + ghcOptDynLinkMode = toFlag GhcStaticAndDynamic, + ghcOptDynHiSuffix = toFlag "dyn_hi", + ghcOptDynObjSuffix = toFlag "dyn_o", + ghcOptHPCDir = hpcdir Hpc.Dyn + } + + unless (forRepl || (null (libModules lib) && null jsSrcs && null cObjs)) $ + do let vanilla = whenVanillaLib forceVanillaLib (runGhcjsProg vanillaOpts) + shared = whenSharedLib forceSharedLib (runGhcjsProg sharedOpts) + useDynToo = dynamicTooSupported && + (forceVanillaLib || withVanillaLib lbi) && + (forceSharedLib || withSharedLib lbi) && + null (ghcjsSharedOptions libBi) + if useDynToo + then do + runGhcjsProg vanillaSharedOpts + case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of + (Cabal.Flag dynDir, Cabal.Flag vanillaDir) -> do + -- When the vanilla and shared library builds are done + -- in one pass, only one set of HPC module interfaces + -- are generated. This set should suffice for both + -- static and dynamically linked executables. We copy + -- the modules interfaces so they are available under + -- both ways. + copyDirectoryRecursive verbosity dynDir vanillaDir + _ -> return () + else if isGhcjsDynamic + then do shared; vanilla + else do vanilla; shared + whenProfLib (runGhcjsProg profOpts) + + -- build any C sources + unless (null (cSources libBi) || not nativeToo) $ do + info verbosity "Building C Sources..." + sequence_ + [ do let vanillaCcOpts = + (Internal.componentCcGhcOptions verbosity implInfo + lbi libBi clbi libTargetDir filename) + profCcOpts = vanillaCcOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptObjSuffix = toFlag "p_o" + } + sharedCcOpts = vanillaCcOpts `mappend` mempty { + ghcOptFPic = toFlag True, + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptObjSuffix = toFlag "dyn_o" + } + odir = fromFlag (ghcOptObjDir vanillaCcOpts) + createDirectoryIfMissingVerbose verbosity True odir + runGhcjsProg vanillaCcOpts + whenSharedLib forceSharedLib (runGhcjsProg sharedCcOpts) + whenProfLib (runGhcjsProg profCcOpts) + | filename <- cSources libBi] + + -- TODO: problem here is we need the .c files built first, so we can load them + -- with ghci, but .c files can depend on .h files generated by ghc by ffi + -- exports. + unless (null (libModules lib)) $ + ifReplLib (runGhcjsProg replOpts) + + -- link: + when (nativeToo && not forRepl) $ do + info verbosity "Linking..." + let cProfObjs = map (`replaceExtension` ("p_" ++ objExtension)) + (cSources libBi) + cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension)) + (cSources libBi) + cid = compilerId (compiler lbi) + vanillaLibFilePath = libTargetDir mkLibName libName + profileLibFilePath = libTargetDir mkProfLibName libName + sharedLibFilePath = libTargetDir mkSharedLibName cid libName + ghciLibFilePath = libTargetDir Internal.mkGHCiLibName libName + + hObjs <- Internal.getHaskellObjects implInfo lib lbi + libTargetDir objExtension True + hProfObjs <- + if (withProfLib lbi) + then Internal.getHaskellObjects implInfo lib lbi + libTargetDir ("p_" ++ objExtension) True + else return [] + hSharedObjs <- + if (withSharedLib lbi) + then Internal.getHaskellObjects implInfo lib lbi + libTargetDir ("dyn_" ++ objExtension) False + else return [] + + unless (null hObjs && null cObjs) $ do + + let staticObjectFiles = + hObjs + ++ map (libTargetDir ) cObjs + profObjectFiles = + hProfObjs + ++ map (libTargetDir ) cProfObjs + ghciObjFiles = + hObjs + ++ map (libTargetDir ) cObjs + dynamicObjectFiles = + hSharedObjs + ++ map (libTargetDir ) cSharedObjs + -- After the relocation lib is created we invoke ghc -shared + -- with the dependencies spelled out as -package arguments + -- and ghc invokes the linker with the proper library paths + ghcSharedLinkArgs = + mempty { + ghcOptShared = toFlag True, + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptInputFiles = toNubListR dynamicObjectFiles, + ghcOptOutputFile = toFlag sharedLibFilePath, + ghcOptPackageKey = toFlag (pkgKey lbi), + ghcOptNoAutoLinkPackages = toFlag True, + ghcOptPackageDBs = withPackageDB lbi, + ghcOptPackages = toNubListR $ + Internal.mkGhcOptPackages clbi, + ghcOptLinkLibs = toNubListR $ extraLibs libBi, + ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi + } + + whenVanillaLib False $ do + Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles + + whenProfLib $ do + Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles + + whenGHCiLib $ do + (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi) + Ld.combineObjectFiles verbosity ldProg + ghciLibFilePath ghciObjFiles + + whenSharedLib False $ + runGhcjsProg ghcSharedLinkArgs + +-- | Start a REPL without loading any source files. +startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler + -> PackageDBStack -> IO () +startInterpreter verbosity conf comp packageDBs = do + let replOpts = mempty { + ghcOptMode = toFlag GhcModeInteractive, + ghcOptPackageDBs = packageDBs + } + checkPackageDbStack packageDBs + (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram conf + runGHC verbosity ghcjsProg comp replOpts + +buildExe, replExe :: Verbosity -> Cabal.Flag (Maybe Int) + -> PackageDescription -> LocalBuildInfo + -> Executable -> ComponentLocalBuildInfo -> IO () +buildExe = buildOrReplExe False +replExe = buildOrReplExe True + +buildOrReplExe :: Bool -> Verbosity -> Cabal.Flag (Maybe Int) + -> PackageDescription -> LocalBuildInfo + -> Executable -> ComponentLocalBuildInfo -> IO () +buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi + exe@Executable { exeName = exeName', modulePath = modPath } clbi = do + + (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi) + let comp = compiler lbi + implInfo = getImplInfo comp + runGhcjsProg = runGHC verbosity ghcjsProg comp + exeBi = buildInfo exe + + -- exeNameReal, the name that GHC really uses (with .exe on Windows) + let exeNameReal = exeName' <.> + (if takeExtension exeName' /= ('.':exeExtension) + then exeExtension + else "") + + let targetDir = (buildDir lbi) exeName' + let exeDir = targetDir (exeName' ++ "-tmp") + createDirectoryIfMissingVerbose verbosity True targetDir + createDirectoryIfMissingVerbose verbosity True exeDir + -- 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 = fromFlag $ configCoverage $ configFlags lbi + distPref = fromFlag $ configDistPref $ configFlags lbi + hpcdir way + | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way exeName' + | otherwise = mempty + + -- build executables + + srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath + let isGhcjsDynamic = isDynamic comp + dynamicTooSupported = supportsDynamicToo comp + buildRunner = case clbi of + ExeComponentLocalBuildInfo {} -> False + _ -> True + isHaskellMain = elem (takeExtension srcMainFile) [".hs", ".lhs"] + jsSrcs = jsSources exeBi + cSrcs = cSources exeBi ++ [srcMainFile | not isHaskellMain] + cObjs = map (`replaceExtension` objExtension) cSrcs + nativeToo = ghcjsNativeToo comp + baseOpts = (componentGhcOptions verbosity lbi exeBi clbi exeDir) + `mappend` mempty { + ghcOptMode = toFlag GhcModeMake, + ghcOptInputFiles = toNubListR $ + [ srcMainFile | isHaskellMain], + ghcOptInputModules = toNubListR $ + [ m | not isHaskellMain, m <- exeModules exe], + ghcOptExtra = + if buildRunner then toNubListR ["-build-runner"] + else mempty + } + staticOpts = baseOpts `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcStaticOnly, + ghcOptHPCDir = hpcdir Hpc.Vanilla + } + profOpts = adjustExts "p_hi" "p_o" baseOpts `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptExtra = toNubListR $ ghcjsProfOptions exeBi, + ghcOptHPCDir = hpcdir Hpc.Prof + } + dynOpts = adjustExts "dyn_hi" "dyn_o" baseOpts `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcDynamicOnly, + ghcOptExtra = toNubListR $ + ghcjsSharedOptions exeBi, + ghcOptHPCDir = hpcdir Hpc.Dyn + } + dynTooOpts = adjustExts "dyn_hi" "dyn_o" staticOpts `mappend` mempty { + ghcOptDynLinkMode = toFlag GhcStaticAndDynamic, + ghcOptHPCDir = hpcdir Hpc.Dyn + } + linkerOpts = mempty { + ghcOptLinkOptions = toNubListR $ PD.ldOptions exeBi, + ghcOptLinkLibs = toNubListR $ extraLibs exeBi, + ghcOptLinkLibPath = toNubListR $ extraLibDirs exeBi, + ghcOptLinkFrameworks = toNubListR $ PD.frameworks exeBi, + ghcOptInputFiles = toNubListR $ + [exeDir x | x <- cObjs] ++ jsSrcs + } + replOpts = baseOpts { + ghcOptExtra = overNubListR + Internal.filterGhciFlags + (ghcOptExtra baseOpts) + } + -- For a normal compile we do separate invocations of ghc for + -- compiling as for linking. But for repl we have to do just + -- the one invocation, so that one has to include all the + -- linker stuff too, like -l flags and any .o files from C + -- files etc. + `mappend` linkerOpts + `mappend` mempty { + ghcOptMode = toFlag GhcModeInteractive, + ghcOptOptimisation = toFlag GhcNoOptimisation + } + commonOpts | withProfExe lbi = profOpts + | withDynExe lbi = dynOpts + | otherwise = staticOpts + compileOpts | useDynToo = dynTooOpts + | otherwise = commonOpts + withStaticExe = (not $ withProfExe lbi) && (not $ withDynExe lbi) + + -- For building exe's that use TH with -prof or -dynamic we actually have + -- to build twice, once without -prof/-dynamic and then again with + -- -prof/-dynamic. This is because the code that TH needs to run at + -- compile time needs to be the vanilla ABI so it can be loaded up and run + -- by the compiler. + -- With dynamic-by-default GHC the TH object files loaded at compile-time + -- need to be .dyn_o instead of .o. + doingTH = EnableExtension TemplateHaskell `elem` allExtensions exeBi + -- Should we use -dynamic-too instead of compiling twice? + useDynToo = dynamicTooSupported && isGhcjsDynamic + && doingTH && withStaticExe && null (ghcjsSharedOptions exeBi) + compileTHOpts | isGhcjsDynamic = dynOpts + | otherwise = staticOpts + compileForTH + | forRepl = False + | useDynToo = False + | isGhcjsDynamic = doingTH && (withProfExe lbi || withStaticExe) + | otherwise = doingTH && (withProfExe lbi || withDynExe lbi) + + linkOpts = commonOpts `mappend` + linkerOpts `mappend` mempty { + ghcOptLinkNoHsMain = toFlag (not isHaskellMain) + } + + -- Build static/dynamic object files for TH, if needed. + when compileForTH $ + runGhcjsProg compileTHOpts { ghcOptNoLink = toFlag True + , ghcOptNumJobs = numJobs } + + unless forRepl $ + runGhcjsProg compileOpts { ghcOptNoLink = toFlag True + , ghcOptNumJobs = numJobs } + + -- build any C sources + unless (null cSrcs || not nativeToo) $ do + info verbosity "Building C Sources..." + sequence_ + [ do let opts = (Internal.componentCcGhcOptions verbosity implInfo lbi exeBi + clbi exeDir filename) `mappend` mempty { + ghcOptDynLinkMode = toFlag (if withDynExe lbi + then GhcDynamicOnly + else GhcStaticOnly), + ghcOptProfilingMode = toFlag (withProfExe lbi) + } + odir = fromFlag (ghcOptObjDir opts) + createDirectoryIfMissingVerbose verbosity True odir + runGhcjsProg opts + | filename <- cSrcs ] + + -- TODO: problem here is we need the .c files built first, so we can load them + -- with ghci, but .c files can depend on .h files generated by ghc by ffi + -- exports. + when forRepl $ runGhcjsProg replOpts + + -- link: + unless forRepl $ do + info verbosity "Linking..." + runGhcjsProg linkOpts { ghcOptOutputFile = toFlag (targetDir exeNameReal) } + +-- |Install for ghc, .hi, .a and, if --with-ghci given, .o +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 + whenVanilla $ copyModuleFiles "js_hi" + whenProf $ copyModuleFiles "js_p_hi" + whenShared $ copyModuleFiles "js_dyn_hi" + + whenVanilla $ mapM_ (installOrdinary builtDir targetDir . toJSLibName) vanillaLibNames + whenProf $ mapM_ (installOrdinary builtDir targetDir . toJSLibName) profileLibNames + whenShared $ mapM_ (installShared builtDir dynlibTargetDir . toJSLibName) sharedLibNames + + when (ghcjsNativeToo $ compiler lbi) $ do + -- copy .hi files over: + whenVanilla $ copyModuleFiles "hi" + whenProf $ copyModuleFiles "p_hi" + whenShared $ copyModuleFiles "dyn_hi" + + -- copy the built library files over: + whenVanilla $ mapM_ (installOrdinary builtDir targetDir) vanillaLibNames + whenProf $ mapM_ (installOrdinary builtDir targetDir) profileLibNames + whenGHCi $ mapM_ (installOrdinary builtDir targetDir) ghciLibNames + whenShared $ mapM_ (installShared builtDir dynlibTargetDir) sharedLibNames + + where + install isShared srcDir dstDir name = do + let src = srcDir name + dst = dstDir name + createDirectoryIfMissingVerbose verbosity True dstDir + if isShared + then do when (stripLibs lbi) $ Strip.stripLib verbosity + (hostPlatform lbi) (withPrograms lbi) src + installExecutableFile verbosity src dst + else installOrdinaryFile verbosity src dst + + installOrdinary = install False + installShared = install True + + copyModuleFiles ext = + findModuleFiles [builtDir] [ext] (libModules lib) + >>= installOrdinaryFiles verbosity targetDir + + cid = compilerId (compiler lbi) + libNames = componentLibraries clbi + vanillaLibNames = map mkLibName libNames + profileLibNames = map mkProfLibName libNames + ghciLibNames = map Internal.mkGHCiLibName libNames + sharedLibNames = map (mkSharedLibName cid) libNames + + hasLib = not $ null (libModules lib) + && null (cSources (libBuildInfo lib)) + whenVanilla = when (hasLib && withVanillaLib lbi) + whenProf = when (hasLib && withProfLib lbi) + whenGHCi = when (hasLib && withGHCiLib lbi) + whenShared = when (hasLib && withSharedLib lbi) + +installExe :: Verbosity + -> LocalBuildInfo + -> InstallDirs FilePath -- ^Where to copy the files to + -> FilePath -- ^Build location + -> (FilePath, FilePath) -- ^Executable (prefix,suffix) + -> PackageDescription + -> Executable + -> IO () +installExe verbosity lbi installDirs buildPref + (progprefix, progsuffix) _pkg exe = do + let binDir = bindir installDirs + createDirectoryIfMissingVerbose verbosity True binDir + let exeFileName = exeName exe + fixedExeBaseName = progprefix ++ exeName exe ++ progsuffix + installBinary dest = do + rawSystemProgramConf verbosity ghcjsProgram (withPrograms lbi) $ + [ "--install-executable" + , buildPref exeName exe exeFileName + , "-o", dest + ] ++ + case (stripExes lbi, lookupProgram stripProgram $ withPrograms lbi) of + (True, Just strip) -> ["-strip-program", programPath strip] + _ -> [] + installBinary (binDir fixedExeBaseName) + +libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo + -> Library -> ComponentLocalBuildInfo -> IO String +libAbiHash verbosity _pkg_descr lbi lib clbi = do + let + libBi = libBuildInfo lib + comp = compiler lbi + vanillaArgs = + (componentGhcOptions verbosity lbi libBi clbi (buildDir lbi)) + `mappend` mempty { + ghcOptMode = toFlag GhcModeAbiHash, + ghcOptPackageKey = toFlag (pkgKey lbi), + ghcOptInputModules = toNubListR $ exposedModules lib + } + profArgs = adjustExts "js_p_hi" "js_p_o" vanillaArgs `mappend` mempty { + ghcOptProfilingMode = toFlag True, + ghcOptExtra = toNubListR (ghcjsProfOptions libBi) + } + ghcArgs = if withVanillaLib lbi then vanillaArgs + else if withProfLib lbi then profArgs + else error "libAbiHash: Can't find an enabled library way" + -- + (ghcjsProg, _) <- requireProgram verbosity ghcjsProgram (withPrograms lbi) + getProgramInvocationOutput verbosity (ghcInvocation ghcjsProg comp ghcArgs) + +adjustExts :: String -> String -> GhcOptions -> GhcOptions +adjustExts hiSuf objSuf opts = + opts `mappend` mempty { + ghcOptHiSuffix = toFlag hiSuf, + ghcOptObjSuffix = toFlag objSuf + } + +registerPackage :: Verbosity + -> InstalledPackageInfo + -> PackageDescription + -> LocalBuildInfo + -> Bool + -> PackageDBStack + -> IO () +registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = + HcPkg.reregister (hcPkgInfo $ withPrograms lbi) verbosity packageDbs + (Right installedPkgInfo) + +componentGhcOptions :: Verbosity -> LocalBuildInfo + -> BuildInfo -> ComponentLocalBuildInfo -> FilePath + -> GhcOptions +componentGhcOptions verbosity lbi bi clbi odir = + let opts = Internal.componentGhcOptions verbosity lbi bi clbi odir + in opts { ghcOptExtra = ghcOptExtra opts `mappend` toNubListR + (hcOptions GHCJS bi) + } + +ghcjsProfOptions :: BuildInfo -> [String] +ghcjsProfOptions bi = + hcProfOptions GHC bi `mappend` hcProfOptions GHCJS bi + +ghcjsSharedOptions :: BuildInfo -> [String] +ghcjsSharedOptions bi = + hcSharedOptions GHC bi `mappend` hcSharedOptions GHCJS bi + +isDynamic :: Compiler -> Bool +isDynamic = Internal.ghcLookupProperty "GHC Dynamic" + +supportsDynamicToo :: Compiler -> Bool +supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too" + +findGhcjsGhcVersion :: Verbosity -> FilePath -> IO (Maybe Version) +findGhcjsGhcVersion verbosity pgm = + findProgramVersion "--numeric-ghc-version" id verbosity pgm + +findGhcjsPkgGhcVersion :: Verbosity -> FilePath -> IO (Maybe Version) +findGhcjsPkgGhcVersion verbosity pgm = + findProgramVersion "--numeric-ghc-version" id verbosity pgm + +-- ----------------------------------------------------------------------------- +-- Registering + +hcPkgInfo :: ProgramConfiguration -> HcPkg.HcPkgInfo +hcPkgInfo conf = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcjsPkgProg + , HcPkg.noPkgDbStack = False + , HcPkg.noVerboseFlag = False + , HcPkg.flagPackageConf = False + } + where + Just ghcjsPkgProg = lookupProgram ghcjsPkgProgram conf + +-- | Get the JavaScript file name and command and arguments to run a +-- program compiled by GHCJS +-- the exe should be the base program name without exe extension +runCmd :: ProgramConfiguration -> FilePath + -> (FilePath, FilePath, [String]) +runCmd conf exe = + ( script + , programPath ghcjsProg + , programDefaultArgs ghcjsProg ++ programOverrideArgs ghcjsProg ++ ["--run"] + ) + where + script = exe <.> "jsexe" "all" <.> "js" + Just ghcjsProg = lookupProgram ghcjsProgram conf diff --git a/Distribution/Simple/Haddock.hs b/Distribution/Simple/Haddock.hs --- a/Distribution/Simple/Haddock.hs +++ b/Distribution/Simple/Haddock.hs @@ -20,6 +20,9 @@ haddockPackagePaths ) where +import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.GHCJS as GHCJS + -- local import Distribution.Package ( PackageIdentifier(..) @@ -28,34 +31,36 @@ import qualified Distribution.ModuleName as ModuleName import Distribution.PackageDescription as PD ( PackageDescription(..), BuildInfo(..), usedExtensions + , hcSharedOptions , Library(..), hasLibs, Executable(..) , TestSuite(..), TestSuiteInterface(..) , Benchmark(..), BenchmarkInterface(..) ) import Distribution.Simple.Compiler - ( Compiler(..), compilerVersion ) -import Distribution.Simple.GHC ( componentGhcOptions, ghcLibDir ) + ( Compiler, compilerInfo, CompilerFlavor(..) + , compilerFlavor, compilerCompatVersion ) import Distribution.Simple.Program.GHC ( GhcOptions(..), GhcDynLinkMode(..), renderGhcOptions ) import Distribution.Simple.Program - ( ConfiguredProgram(..), requireProgramVersion + ( ConfiguredProgram(..), lookupProgramVersion, requireProgramVersion , rawSystemProgram, rawSystemProgramStdout , hscolourProgram, haddockProgram ) -import Distribution.Simple.PreProcess (PPSuffixHandler - , preprocessComponent) +import Distribution.Simple.PreProcess + ( PPSuffixHandler, preprocessComponent) import Distribution.Simple.Setup - ( defaultHscolourFlags, Flag(..), toFlag, flagToMaybe, flagToList, fromFlag - , HaddockFlags(..), HscolourFlags(..) ) + ( defaultHscolourFlags + , Flag(..), toFlag, flagToMaybe, flagToList, fromFlag + , HaddockFlags(..), HscolourFlags(..) ) import Distribution.Simple.Build (initialBuildSteps) -import Distribution.Simple.InstallDirs (InstallDirs(..), PathTemplateEnv, PathTemplate, - PathTemplateVariable(..), - toPathTemplate, fromPathTemplate, - substPathTemplate, initialPathTemplateEnv) +import Distribution.Simple.InstallDirs + ( InstallDirs(..) + , PathTemplateEnv, PathTemplate, PathTemplateVariable(..) + , toPathTemplate, fromPathTemplate + , substPathTemplate, initialPathTemplateEnv ) import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), Component(..), ComponentLocalBuildInfo(..) , withAllComponentsInBuildOrder ) -import Distribution.Simple.BuildPaths ( haddockName, - hscolourPref, autogenModulesDir, - ) +import Distribution.Simple.BuildPaths + ( haddockName, hscolourPref, autogenModulesDir) import Distribution.Simple.PackageIndex (dependencyClosure) import qualified Distribution.Simple.PackageIndex as PackageIndex import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo @@ -71,46 +76,64 @@ , findFileWithExtension, findFile ) import Distribution.Text ( display, simpleParse ) +import Distribution.Utils.NubList + ( toNubListR ) import Distribution.Verbosity import Language.Haskell.Extension --- Base -import System.Directory(doesFileExist) -import Control.Monad ( when, forM_ ) -import Data.Either ( rights ) + +import Control.Monad ( when, forM_ ) +import Data.Either ( rights ) import Data.Monoid -import Data.Maybe ( fromMaybe, listToMaybe ) +import Data.Maybe ( fromMaybe, listToMaybe ) -import System.FilePath((), (<.>), - normalise, splitPath, joinPath, isAbsolute ) -import System.IO (hClose, hPutStrLn, hSetEncoding, utf8) +import System.Directory (doesFileExist) +import System.FilePath ( (), (<.>) + , normalise, splitPath, joinPath, isAbsolute ) +import System.IO (hClose, hPutStrLn, hSetEncoding, utf8) import Distribution.Version -- ------------------------------------------------------------------------------ -- Types --- | record that represents the arguments to the haddock executable, a product monoid. +-- | A record that represents the arguments to the haddock executable, a product +-- monoid. data HaddockArgs = HaddockArgs { - argInterfaceFile :: Flag FilePath, -- ^ path of the interface file, relative to argOutputDir, required. - argPackageName :: Flag PackageIdentifier, -- ^ package name, required. - argHideModules :: (All,[ModuleName.ModuleName]), -- ^ (hide modules ?, modules to hide) - argIgnoreExports :: Any, -- ^ ignore export lists in modules? - argLinkSource :: Flag (Template,Template,Template), -- ^ (template for modules, template for symbols, template for lines) - argCssFile :: Flag FilePath, -- ^ optional custom CSS file. - argContents :: Flag String, -- ^ optional URL to contents page + argInterfaceFile :: Flag FilePath, + -- ^ Path to the interface file, relative to argOutputDir, required. + argPackageName :: Flag PackageIdentifier, + -- ^ Package name, required. + argHideModules :: (All,[ModuleName.ModuleName]), + -- ^ (Hide modules ?, modules to hide) + argIgnoreExports :: Any, + -- ^ Ignore export lists in modules? + argLinkSource :: Flag (Template,Template,Template), + -- ^ (Template for modules, template for symbols, template for lines). + argCssFile :: Flag FilePath, + -- ^ Optional custom CSS file. + argContents :: Flag String, + -- ^ Optional URL to contents page. argVerbose :: Any, - argOutput :: Flag [Output], -- ^ HTML or Hoogle doc or both? required. - argInterfaces :: [(FilePath, Maybe String)], -- ^ [(interface file, URL to the HTML docs for links)] - argOutputDir :: Directory, -- ^ where to generate the documentation. - argTitle :: Flag String, -- ^ page's title, required. - argPrologue :: Flag String, -- ^ prologue text, required. - argGhcOptions :: Flag (GhcOptions, Version), -- ^ additional flags to pass to ghc - argGhcLibDir :: Flag FilePath, -- ^ to find the correct ghc, required. - argTargets :: [FilePath] -- ^ modules to process. + argOutput :: Flag [Output], + -- ^ HTML or Hoogle doc or both? Required. + argInterfaces :: [(FilePath, Maybe String)], + -- ^ [(Interface file, URL to the HTML docs for links)]. + argOutputDir :: Directory, + -- ^ Where to generate the documentation. + argTitle :: Flag String, + -- ^ Page title, required. + argPrologue :: Flag String, + -- ^ Prologue text, required. + argGhcOptions :: Flag (GhcOptions, Version), + -- ^ Additional flags to pass to GHC. + argGhcLibDir :: Flag FilePath, + -- ^ To find the correct GHC, required. + argTargets :: [FilePath] + -- ^ Modules to process. } --- | the FilePath of a directory, it's a monoid under () +-- | The FilePath of a directory, it's a monoid under '()'. newtype Directory = Dir { unDir' :: FilePath } deriving (Read,Show,Eq,Ord) unDir :: Directory -> FilePath @@ -123,7 +146,11 @@ -- ------------------------------------------------------------------------------ -- Haddock support -haddock :: PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HaddockFlags -> IO () +haddock :: PackageDescription + -> LocalBuildInfo + -> [PPSuffixHandler] + -> HaddockFlags + -> IO () haddock pkg_descr _ _ haddockFlags | not (hasLibs pkg_descr) && not (fromFlag $ haddockExecutables haddockFlags) @@ -148,23 +175,24 @@ haddockGhcVersionStr <- rawSystemProgramStdout verbosity confHaddock ["--ghc-version"] - case simpleParse haddockGhcVersionStr of - Nothing -> die "Could not get GHC version from Haddock" - Just haddockGhcVersion + case (simpleParse haddockGhcVersionStr, compilerCompatVersion GHC comp) of + (Nothing, _) -> die "Could not get GHC version from Haddock" + (_, Nothing) -> die "Could not get GHC version from compiler" + (Just haddockGhcVersion, Just ghcVersion) | haddockGhcVersion == ghcVersion -> return () | otherwise -> die $ "Haddock's internal GHC version must match the configured " ++ "GHC version.\n" ++ "The GHC version is " ++ display ghcVersion ++ " but " ++ "haddock is using GHC version " ++ display haddockGhcVersion - where ghcVersion = compilerVersion comp -- the tools match the requests, we can proceed initialBuildSteps (flag haddockDistPref) pkg_descr lbi verbosity - when (flag haddockHscolour) $ hscolour' pkg_descr lbi suffixes $ - defaultHscolourFlags `mappend` haddockToHscolour flags + when (flag haddockHscolour) $ + hscolour' (warn verbosity) pkg_descr lbi suffixes + (defaultHscolourFlags `mappend` haddockToHscolour flags) libdirArgs <- getGhcLibDir verbosity lbi let commonArgs = mconcat @@ -178,22 +206,24 @@ let doExe com = case (compToExe com) of Just exe -> do - withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $ \tmp -> do - exeArgs <- fromExecutable verbosity tmp lbi exe clbi htmlTemplate - version - let exeArgs' = commonArgs `mappend` exeArgs - runHaddock verbosity tmpFileOpts comp confHaddock exeArgs' + withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $ + \tmp -> do + exeArgs <- fromExecutable verbosity tmp lbi exe clbi htmlTemplate + version + let exeArgs' = commonArgs `mappend` exeArgs + runHaddock verbosity tmpFileOpts comp confHaddock exeArgs' Nothing -> do warn (fromFlag $ haddockVerbosity flags) "Unsupported component, skipping..." return () case component of CLib lib -> do - withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $ \tmp -> do - libArgs <- fromLibrary verbosity tmp lbi lib clbi htmlTemplate - version - let libArgs' = commonArgs `mappend` libArgs - runHaddock verbosity tmpFileOpts comp confHaddock libArgs' + withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $ + \tmp -> do + libArgs <- fromLibrary verbosity tmp lbi lib clbi htmlTemplate + version + let libArgs' = commonArgs `mappend` libArgs + runHaddock verbosity tmpFileOpts comp confHaddock libArgs' CExe _ -> when (flag haddockExecutables) $ doExe component CTest _ -> when (flag haddockTestSuites) $ doExe component CBench _ -> when (flag haddockBenchmarks) $ doExe component @@ -207,7 +237,8 @@ comp = compiler lbi tmpFileOpts = defaultTempFileOptions { optKeepTempFiles = keepTempFiles } flag f = fromFlag $ f flags - htmlTemplate = fmap toPathTemplate . flagToMaybe . haddockHtmlLocation $ flags + htmlTemplate = fmap toPathTemplate . flagToMaybe . haddockHtmlLocation + $ flags -- ------------------------------------------------------------------------------ -- Contributions to HaddockArgs. @@ -215,15 +246,18 @@ fromFlags :: PathTemplateEnv -> HaddockFlags -> HaddockArgs fromFlags env flags = mempty { - argHideModules = (maybe mempty (All . not) $ flagToMaybe (haddockInternal flags), mempty), + argHideModules = (maybe mempty (All . not) + $ flagToMaybe (haddockInternal flags), mempty), argLinkSource = if fromFlag (haddockHscolour flags) then Flag ("src/%{MODULE/./-}.html" ,"src/%{MODULE/./-}.html#%{NAME}" ,"src/%{MODULE/./-}.html#line-%{LINE}") else NoFlag, argCssFile = haddockCss flags, - argContents = fmap (fromPathTemplate . substPathTemplate env) (haddockContents flags), - argVerbose = maybe mempty (Any . (>= deafening)) . flagToMaybe $ haddockVerbosity flags, + argContents = fmap (fromPathTemplate . substPathTemplate env) + (haddockContents flags), + argVerbose = maybe mempty (Any . (>= deafening)) + . flagToMaybe $ haddockVerbosity flags, argOutput = Flag $ case [ Html | Flag True <- [haddockHtml flags] ] ++ [ Hoogle | Flag True <- [haddockHoogle flags] ] @@ -234,12 +268,13 @@ fromPackageDescription :: PackageDescription -> HaddockArgs fromPackageDescription pkg_descr = - mempty { - argInterfaceFile = Flag $ haddockName pkg_descr, - argPackageName = Flag $ packageId $ pkg_descr, - argOutputDir = Dir $ "doc" "html" display (packageName pkg_descr), - argPrologue = Flag $ if null desc then synopsis pkg_descr else desc, - argTitle = Flag $ showPkg ++ subtitle + mempty { argInterfaceFile = Flag $ haddockName pkg_descr, + argPackageName = Flag $ packageId $ pkg_descr, + argOutputDir = Dir $ "doc" "html" + display (packageName pkg_descr), + argPrologue = Flag $ if null desc then synopsis pkg_descr + else desc, + argTitle = Flag $ showPkg ++ subtitle } where desc = PD.description pkg_descr @@ -247,6 +282,18 @@ subtitle | null (synopsis pkg_descr) = "" | otherwise = ": " ++ synopsis pkg_descr +componentGhcOptions :: Verbosity -> LocalBuildInfo + -> BuildInfo -> ComponentLocalBuildInfo -> FilePath + -> GhcOptions +componentGhcOptions verbosity lbi bi clbi odir = + let f = case compilerFlavor (compiler lbi) of + GHC -> GHC.componentGhcOptions + GHCJS -> GHCJS.componentGhcOptions + _ -> error $ + "Distribution.Simple.Haddock.componentGhcOptions:" ++ + "haddock only supports GHC and GHCJS" + in f verbosity lbi bi clbi odir + fromLibrary :: Verbosity -> FilePath -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo @@ -270,13 +317,20 @@ ghcOptFPic = toFlag True, ghcOptHiSuffix = toFlag "dyn_hi", ghcOptObjSuffix = toFlag "dyn_o", - ghcOptExtra = ghcSharedOptions bi + ghcOptExtra = + toNubListR $ hcSharedOptions GHC bi + } opts <- if withVanillaLib lbi then return vanillaOpts else if withSharedLib lbi then return sharedOpts - else die "Must have vanilla or shared libraries enabled in order to run haddock" + else die $ "Must have vanilla or shared libraries " + ++ "enabled in order to run haddock" + ghcVersion <- maybe (die "Compiler has no GHC version") + return + (compilerCompatVersion GHC (compiler lbi)) + return ifaceArgs { argHideModules = (mempty,otherModules $ bi), argGhcOptions = toFlag (opts, ghcVersion), @@ -284,7 +338,6 @@ } where bi = libBuildInfo lib - ghcVersion = compilerVersion (compiler lbi) fromExecutable :: Verbosity -> FilePath @@ -309,13 +362,19 @@ ghcOptFPic = toFlag True, ghcOptHiSuffix = toFlag "dyn_hi", ghcOptObjSuffix = toFlag "dyn_o", - ghcOptExtra = ghcSharedOptions bi + ghcOptExtra = + toNubListR $ hcSharedOptions GHC bi } opts <- if withVanillaLib lbi then return vanillaOpts else if withSharedLib lbi then return sharedOpts - else die "Must have vanilla or shared libraries enabled in order to run haddock" + else die $ "Must have vanilla or shared libraries " + ++ "enabled in order to run haddock" + ghcVersion <- maybe (die "Compiler has no GHC version") + return + (compilerCompatVersion GHC (compiler lbi)) + return ifaceArgs { argGhcOptions = toFlag (opts, ghcVersion), argOutputDir = Dir (exeName exe), @@ -324,7 +383,6 @@ } where bi = buildInfo exe - ghcVersion = compilerVersion (compiler lbi) compToExe :: Component -> Maybe Executable compToExe comp = @@ -361,8 +419,8 @@ -> GhcOptions getGhcCppOpts haddockVersion bi = mempty { - ghcOptExtensions = [EnableExtension CPP | needsCpp], - ghcOptCppOptions = defines + ghcOptExtensions = toNubListR [EnableExtension CPP | needsCpp], + ghcOptCppOptions = toNubListR defines } where needsCpp = EnableExtension CPP `elem` usedExtensions bi @@ -375,7 +433,10 @@ getGhcLibDir :: Verbosity -> LocalBuildInfo -> IO HaddockArgs getGhcLibDir verbosity lbi = do - l <- ghcLibDir verbosity lbi + l <- case compilerFlavor (compiler lbi) of + GHC -> GHC.getLibDir verbosity lbi + GHCJS -> GHCJS.getLibDir verbosity lbi + _ -> error "haddock only supports GHC and GHCJS" return $ mempty { argGhcLibDir = Flag l } -- ------------------------------------------------------------------------------ @@ -406,12 +467,13 @@ -> IO a renderArgs verbosity tmpFileOpts version comp args k = do createDirectoryIfMissingVerbose verbosity True outputDir - withTempFileEx tmpFileOpts outputDir "haddock-prolog.txt" $ \prologFileName h -> do + withTempFileEx tmpFileOpts outputDir "haddock-prologue.txt" $ + \prologueFileName h -> do do when (version >= Version [2,14,4] []) (hSetEncoding h utf8) hPutStrLn h $ fromFlag $ argPrologue args hClose h - let pflag = "--prologue=" ++ prologFileName + let pflag = "--prologue=" ++ prologueFileName k (pflag : renderPureArgs version comp args, result) where outputDir = (unDir $ argOutputDir args) @@ -428,30 +490,49 @@ renderPureArgs :: Version -> Compiler -> HaddockArgs -> [String] renderPureArgs version comp args = concat - [ - (:[]) . (\f -> "--dump-interface="++ unDir (argOutputDir args) f) - . fromFlag . argInterfaceFile $ args, - (\pname -> ["--optghc=-package-name", "--optghc=" ++ pname] - ) . display . fromFlag . argPackageName $ args, - (\(All b,xs) -> bool (map (("--hide=" ++). display) xs) [] b) . argHideModules $ args, - bool ["--ignore-all-exports"] [] . getAny . argIgnoreExports $ args, - maybe [] (\(m,e,l) -> ["--source-module=" ++ m - ,"--source-entity=" ++ e] - ++ if isVersion2_14 then ["--source-entity-line=" ++ l] - else [] - ) . flagToMaybe . argLinkSource $ args, - maybe [] ((:[]).("--css="++)) . flagToMaybe . argCssFile $ args, - maybe [] ((:[]).("--use-contents="++)) . flagToMaybe . argContents $ args, - bool [] [verbosityFlag] . getAny . argVerbose $ args, - map (\o -> case o of Hoogle -> "--hoogle"; Html -> "--html") . fromFlag . argOutput $ args, - renderInterfaces . argInterfaces $ args, - (:[]).("--odir="++) . unDir . argOutputDir $ args, - (:[]).("--title="++) . (bool (++" (internal documentation)") id (getAny $ argIgnoreExports args)) - . fromFlag . argTitle $ args, - [ "--optghc=" ++ opt | (opts, _ghcVer) <- flagToList (argGhcOptions args) - , opt <- renderGhcOptions comp opts ], - maybe [] (\l -> ["-B"++l]) $ flagToMaybe (argGhcLibDir args), -- error if Nothing? - argTargets $ args + [ (:[]) . (\f -> "--dump-interface="++ unDir (argOutputDir args) f) + . fromFlag . argInterfaceFile $ args + + , (\pname -> ["--optghc=-package-name", "--optghc=" ++ pname]) + . display . fromFlag . argPackageName $ args + + , (\(All b,xs) -> bool (map (("--hide=" ++). display) xs) [] b) + . argHideModules $ args + + , bool ["--ignore-all-exports"] [] . getAny . argIgnoreExports $ args + + , maybe [] (\(m,e,l) -> + ["--source-module=" ++ m + ,"--source-entity=" ++ e] + ++ if isVersion2_14 then ["--source-entity-line=" ++ l] + else [] + ) . flagToMaybe . argLinkSource $ args + + , maybe [] ((:[]) . ("--css="++)) . flagToMaybe . argCssFile $ args + + , maybe [] ((:[]) . ("--use-contents="++)) . flagToMaybe . argContents $ args + + , bool [] [verbosityFlag] . getAny . argVerbose $ args + + , map (\o -> case o of Hoogle -> "--hoogle"; Html -> "--html") + . fromFlag . argOutput $ args + + , renderInterfaces . argInterfaces $ args + + , (:[]) . ("--odir="++) . unDir . argOutputDir $ args + + , (:[]) . ("--title="++) + . (bool (++" (internal documentation)") + id (getAny $ argIgnoreExports args)) + . fromFlag . argTitle $ args + + , [ "--optghc=" ++ opt | (opts, _ghcVer) <- flagToList (argGhcOptions args) + , opt <- renderGhcOptions comp opts ] + + , maybe [] (\l -> ["-B"++l]) $ + flagToMaybe (argGhcLibDir args) -- error if Nothing? + + , argTargets $ args ] where renderInterfaces = @@ -534,60 +615,68 @@ haddockTemplateEnv :: LocalBuildInfo -> PackageIdentifier -> PathTemplateEnv haddockTemplateEnv lbi pkg_id = (PrefixVar, prefix (installDirTemplates lbi)) - : initialPathTemplateEnv pkg_id (compilerId (compiler lbi)) + : initialPathTemplateEnv pkg_id (pkgKey lbi) (compilerInfo (compiler lbi)) (hostPlatform lbi) -- ------------------------------------------------------------------------------ -- hscolour support. -hscolour :: PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HscolourFlags -> IO () +hscolour :: PackageDescription + -> LocalBuildInfo + -> [PPSuffixHandler] + -> HscolourFlags + -> IO () hscolour pkg_descr lbi suffixes flags = do -- we preprocess even if hscolour won't be found on the machine -- will this upset someone? initialBuildSteps distPref pkg_descr lbi verbosity - hscolour' pkg_descr lbi suffixes flags + hscolour' die pkg_descr lbi suffixes flags where verbosity = fromFlag (hscolourVerbosity flags) distPref = fromFlag $ hscolourDistPref flags -hscolour' :: PackageDescription +hscolour' :: (String -> IO ()) -- ^ Called when the 'hscolour' exe is not found. + -> PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HscolourFlags -> IO () -hscolour' pkg_descr lbi suffixes flags = do - let distPref = fromFlag $ hscolourDistPref flags - (hscolourProg, _, _) <- - requireProgramVersion - verbosity hscolourProgram - (orLaterVersion (Version [1,8] [])) (withPrograms lbi) +hscolour' onNoHsColour pkg_descr lbi suffixes flags = + either onNoHsColour (\(hscolourProg, _, _) -> go hscolourProg) =<< + lookupProgramVersion verbosity hscolourProgram + (orLaterVersion (Version [1,8] [])) (withPrograms lbi) + where + go :: ConfiguredProgram -> IO () + go hscolourProg = do + setupMessage verbosity "Running hscolour for" (packageId pkg_descr) + createDirectoryIfMissingVerbose verbosity True $ + hscolourPref distPref pkg_descr - setupMessage verbosity "Running hscolour for" (packageId pkg_descr) - createDirectoryIfMissingVerbose verbosity True $ hscolourPref distPref pkg_descr + let pre c = preprocessComponent pkg_descr c lbi False verbosity suffixes + withAllComponentsInBuildOrder pkg_descr lbi $ \comp _ -> do + pre comp + let + doExe com = case (compToExe com) of + Just exe -> do + let outputDir = hscolourPref distPref pkg_descr + exeName exe "src" + runHsColour hscolourProg outputDir =<< getExeSourceFiles lbi exe + Nothing -> do + warn (fromFlag $ hscolourVerbosity flags) + "Unsupported component, skipping..." + return () + case comp of + CLib lib -> do + let outputDir = hscolourPref distPref pkg_descr "src" + runHsColour hscolourProg outputDir =<< getLibSourceFiles lbi lib + CExe _ -> when (fromFlag (hscolourExecutables flags)) $ doExe comp + CTest _ -> when (fromFlag (hscolourTestSuites flags)) $ doExe comp + CBench _ -> when (fromFlag (hscolourBenchmarks flags)) $ doExe comp - let pre c = preprocessComponent pkg_descr c lbi False verbosity suffixes - withAllComponentsInBuildOrder pkg_descr lbi $ \comp _ -> do - pre comp - let - doExe com = case (compToExe com) of - Just exe -> do - let outputDir = hscolourPref distPref pkg_descr exeName exe "src" - runHsColour hscolourProg outputDir =<< getExeSourceFiles lbi exe - Nothing -> do - warn (fromFlag $ hscolourVerbosity flags) - "Unsupported component, skipping..." - return () - case comp of - CLib lib -> do - let outputDir = hscolourPref distPref pkg_descr "src" - runHsColour hscolourProg outputDir =<< getLibSourceFiles lbi lib - CExe _ -> when (fromFlag (hscolourExecutables flags)) $ doExe comp - CTest _ -> when (fromFlag (hscolourTestSuites flags)) $ doExe comp - CBench _ -> when (fromFlag (hscolourBenchmarks flags)) $ doExe comp - where stylesheet = flagToMaybe (hscolourCSS flags) verbosity = fromFlag (hscolourVerbosity flags) + distPref = fromFlag (hscolourDistPref flags) runHsColour prog outputDir moduleFiles = do createDirectoryIfMissingVerbose verbosity True outputDir @@ -603,7 +692,8 @@ rawSystemProgram verbosity prog ["-css", "-anchor", "-o" ++ outFile m, inFile] where - outFile m = outputDir intercalate "-" (ModuleName.components m) <.> "html" + outFile m = outputDir + intercalate "-" (ModuleName.components m) <.> "html" haddockToHscolour :: HaddockFlags -> HscolourFlags haddockToHscolour flags = diff --git a/Distribution/Simple/HaskellSuite.hs b/Distribution/Simple/HaskellSuite.hs --- a/Distribution/Simple/HaskellSuite.hs +++ b/Distribution/Simple/HaskellSuite.hs @@ -73,6 +73,8 @@ let comp = Compiler { compilerId = CompilerId (HaskellSuite compName) compVersion, + compilerAbiTag = Compiler.NoAbiTag, + compilerCompat = [], compilerLanguages = languages, compilerExtensions = extensions, compilerProperties = M.empty @@ -117,7 +119,7 @@ -- Other compilers do some kind of a packagedb stack check here. Not sure -- if we need something like that as well. getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration - -> IO PackageIndex + -> IO InstalledPackageIndex getInstalledPackages verbosity packagedbs conf = liftM (PackageIndex.fromList . concat) $ forM packagedbs $ \packagedb -> do str <- @@ -172,6 +174,7 @@ | (ipkgid, _) <- componentPackageDeps clbi ] ++ ["-G", display language] ++ concat [ ["-X", display ex] | ex <- usedExtensions bi ] ++ + cppOptions (libBuildInfo lib) ++ [ display modu | modu <- libModules lib ] diff --git a/Distribution/Simple/Hpc.hs b/Distribution/Simple/Hpc.hs --- a/Distribution/Simple/Hpc.hs +++ b/Distribution/Simple/Hpc.hs @@ -12,8 +12,9 @@ -- build test suites with HPC enabled. module Distribution.Simple.Hpc - ( enableCoverage + ( Way(..), guessWay , htmlDir + , mixDir , tixDir , tixFilePath , markupPackage @@ -21,13 +22,9 @@ ) where import Control.Monad ( when ) -import Distribution.Compiler ( CompilerFlavor(..) ) import Distribution.ModuleName ( main ) import Distribution.PackageDescription - ( BuildInfo(..) - , Library(..) - , PackageDescription(..) - , TestSuite(..) + ( TestSuite(..) , testModules ) import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) ) @@ -38,7 +35,6 @@ import Distribution.Simple.Program.Hpc ( markup, union ) import Distribution.Simple.Utils ( notice ) import Distribution.Version ( anyVersion ) -import Distribution.Text import Distribution.Verbosity ( Verbosity() ) import System.Directory ( createDirectoryIfMissing, doesFileExist ) import System.FilePath @@ -46,63 +42,52 @@ -- ------------------------------------------------------------------------- -- Haskell Program Coverage --- | Conditionally enable Haskell Program Coverage by adding the necessary --- GHC options to a PackageDescription. --- --- TODO: do this differently in the build stage by constructing local build --- info, not by modifying the original PackageDescription. --- -enableCoverage :: Bool -- ^ Enable coverage? - -> String -- ^ \"dist/\" prefix - -> PackageDescription - -> PackageDescription -enableCoverage False _ x = x -enableCoverage True distPref p = - p { library = fmap enableLibCoverage (library p) - , testSuites = map enableTestCoverage (testSuites p) - } - where - enableBICoverage name oldBI = - let oldOptions = options oldBI - oldGHCOpts = lookup GHC oldOptions - newGHCOpts = case oldGHCOpts of - Just xs -> (GHC, hpcOpts ++ xs) - _ -> (GHC, hpcOpts) - newOptions = (:) newGHCOpts $ filter ((== GHC) . fst) oldOptions - hpcOpts = ["-fhpc", "-hpcdir", mixDir distPref name] - in oldBI { options = newOptions } - enableLibCoverage l = - l { libBuildInfo = enableBICoverage (display $ package p) - (libBuildInfo l) - } - enableTestCoverage t = - t { testBuildInfo = enableBICoverage (testName t) (testBuildInfo t) } +data Way = Vanilla | Prof | Dyn + deriving (Bounded, Enum, Eq, Read, Show) hpcDir :: FilePath -- ^ \"dist/\" prefix + -> Way -> FilePath -- ^ Directory containing component's HPC .mix files -hpcDir distPref = distPref "hpc" +hpcDir distPref way = distPref "hpc" wayDir + where + wayDir = case way of + Vanilla -> "vanilla" + Prof -> "prof" + Dyn -> "dyn" mixDir :: FilePath -- ^ \"dist/\" prefix + -> Way -> FilePath -- ^ Component name -> FilePath -- ^ Directory containing test suite's .mix files -mixDir distPref name = hpcDir distPref "mix" name +mixDir distPref way name = hpcDir distPref way "mix" name tixDir :: FilePath -- ^ \"dist/\" prefix + -> Way -> FilePath -- ^ Component name -> FilePath -- ^ Directory containing test suite's .tix files -tixDir distPref name = hpcDir distPref "tix" name +tixDir distPref way name = hpcDir distPref way "tix" name -- | Path to the .tix file containing a test suite's sum statistics. tixFilePath :: FilePath -- ^ \"dist/\" prefix + -> Way -> FilePath -- ^ Component name -> FilePath -- ^ Path to test suite's .tix file -tixFilePath distPref name = tixDir distPref name name <.> "tix" +tixFilePath distPref way name = tixDir distPref way name name <.> "tix" htmlDir :: FilePath -- ^ \"dist/\" prefix + -> Way -> FilePath -- ^ Component name -> FilePath -- ^ Path to test suite's HTML markup directory -htmlDir distPref name = hpcDir distPref "html" name +htmlDir distPref way name = hpcDir distPref way "html" name +-- | Attempt to guess the way the test suites in this package were compiled +-- and linked with the library so the correct module interfaces are found. +guessWay :: LocalBuildInfo -> Way +guessWay lbi + | withProfExe lbi = Prof + | withDynExe lbi = Dyn + | otherwise = Vanilla + -- | Generate the HTML markup for a test suite. markupTest :: Verbosity -> LocalBuildInfo @@ -111,21 +96,22 @@ -> TestSuite -> IO () markupTest verbosity lbi distPref libName suite = do - tixFileExists <- doesFileExist $ tixFilePath distPref $ testName suite + tixFileExists <- doesFileExist $ tixFilePath distPref way $ testName suite when tixFileExists $ do -- behaviour of 'markup' depends on version, so we need *a* version -- but no particular one (hpc, hpcVer, _) <- requireProgramVersion verbosity hpcProgram anyVersion (withPrograms lbi) + let htmlDir_ = htmlDir distPref way $ testName suite markup hpc hpcVer verbosity - (tixFilePath distPref $ testName suite) mixDirs - (htmlDir distPref $ testName suite) + (tixFilePath distPref way $ testName suite) mixDirs + htmlDir_ (testModules suite ++ [ main ]) notice verbosity $ "Test coverage report written to " - ++ htmlDir distPref (testName suite) - "hpc_index" <.> "html" + ++ htmlDir_ "hpc_index" <.> "html" where - mixDirs = map (mixDir distPref) [ testName suite, libName ] + way = guessWay lbi + mixDirs = map (mixDir distPref way) [ testName suite, libName ] -- | Generate the HTML markup for all of a package's test suites. markupPackage :: Verbosity @@ -135,15 +121,15 @@ -> [TestSuite] -> IO () markupPackage verbosity lbi distPref libName suites = do - let tixFiles = map (tixFilePath distPref . testName) suites + let tixFiles = map (tixFilePath distPref way . testName) suites tixFilesExist <- mapM doesFileExist tixFiles when (and tixFilesExist) $ do -- behaviour of 'markup' depends on version, so we need *a* version -- but no particular one (hpc, hpcVer, _) <- requireProgramVersion verbosity hpcProgram anyVersion (withPrograms lbi) - let outFile = tixFilePath distPref libName - htmlDir' = htmlDir distPref libName + let outFile = tixFilePath distPref way libName + htmlDir' = htmlDir distPref way libName excluded = concatMap testModules suites ++ [ main ] createDirectoryIfMissing True $ takeDirectory outFile union hpc verbosity tixFiles outFile excluded @@ -151,4 +137,5 @@ notice verbosity $ "Package coverage report written to " ++ htmlDir' "hpc_index.html" where - mixDirs = map (mixDir distPref) $ libName : map testName suites + way = guessWay lbi + mixDirs = map (mixDir distPref way) $ libName : map testName suites diff --git a/Distribution/Simple/Hugs.hs b/Distribution/Simple/Hugs.hs deleted file mode 100644 --- a/Distribution/Simple/Hugs.hs +++ /dev/null @@ -1,609 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Distribution.Simple.Hugs --- Copyright : Isaac Jones 2003-2006 --- Duncan Coutts 2009 --- License : BSD3 --- --- Maintainer : cabal-devel@haskell.org --- Portability : portable --- --- This module contains most of the NHC-specific code for configuring, building --- and installing packages. - -module Distribution.Simple.Hugs ( - configure, - getInstalledPackages, - buildLib, - buildExe, - install, - registerPackage, - ) where - -import Distribution.Package - ( PackageName, PackageIdentifier(..), InstalledPackageId(..) - , packageName ) -import Distribution.InstalledPackageInfo - ( InstalledPackageInfo, emptyInstalledPackageInfo - , InstalledPackageInfo_( InstalledPackageInfo, installedPackageId - , sourcePackageId ) - , parseInstalledPackageInfo, showInstalledPackageInfo ) -import Distribution.PackageDescription - ( PackageDescription(..), BuildInfo(..), hcOptions, allExtensions - , Executable(..), withExe, Library(..), withLib, libModules ) -import Distribution.ModuleName (ModuleName) -import qualified Distribution.ModuleName as ModuleName -import Distribution.Simple.Compiler - ( CompilerFlavor(..), CompilerId(..) - , Compiler(..), Flag, languageToFlags, extensionsToFlags - , PackageDB(..), PackageDBStack ) -import qualified Distribution.Simple.PackageIndex as PackageIndex -import Distribution.Simple.PackageIndex (PackageIndex) -import Distribution.Simple.Program - ( Program(programFindVersion) - , ProgramConfiguration, userMaybeSpecifyPath - , requireProgram, requireProgramVersion - , rawSystemProgramConf, programPath - , ffihugsProgram, hugsProgram ) -import Distribution.Version - ( Version(..), orLaterVersion ) -import Distribution.Simple.PreProcess ( ppCpp, runSimplePreProcessor ) -import Distribution.Simple.PreProcess.Unlit - ( unlit ) -import Distribution.Simple.LocalBuildInfo - ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) - , InstallDirs(..), absoluteInstallDirs ) -import Distribution.Simple.BuildPaths - ( autogenModuleName, autogenModulesDir, - dllExtension ) -import Distribution.Simple.Setup - ( CopyDest(..) ) -import Distribution.Simple.Utils - ( createDirectoryIfMissingVerbose - , installOrdinaryFiles, setFileExecutable - , withUTF8FileContents, writeFileAtomic, writeUTF8File - , copyFileVerbose, findFile, findFileWithExtension, findModuleFiles - , rawSystemStdInOut - , die, info, notice ) -import Language.Haskell.Extension - ( Language(Haskell98), Extension(..), KnownExtension(..) ) -import System.FilePath ( (), takeExtension, (<.>), - searchPathSeparator, normalise, takeDirectory ) -import Distribution.System - ( OS(..), buildOS ) -import Distribution.Text - ( display, simpleParse ) -import Distribution.ParseUtils - ( ParseResult(..) ) -import Distribution.Verbosity - -import Data.Char ( isSpace ) -import qualified Data.Map as M ( empty ) -import Data.Maybe ( mapMaybe, catMaybes ) -import Data.Monoid ( Monoid(..) ) -import Control.Monad ( unless, when, filterM ) -import Data.List ( nub, sort, isSuffixOf ) -import System.Directory - ( doesFileExist, doesDirectoryExist, getDirectoryContents - , removeDirectoryRecursive, getHomeDirectory ) -import System.Exit - ( ExitCode(ExitSuccess) ) -import Distribution.Compat.Exception -import Distribution.System ( Platform ) - -import qualified Data.ByteString.Lazy.Char8 as BS.Char8 - --- ----------------------------------------------------------------------------- --- Configuring - -configure :: Verbosity -> Maybe FilePath -> Maybe FilePath - -> ProgramConfiguration -> IO (Compiler, Maybe Platform, ProgramConfiguration) -configure verbosity hcPath _hcPkgPath conf = do - - (_ffihugsProg, conf') <- requireProgram verbosity ffihugsProgram - (userMaybeSpecifyPath "ffihugs" hcPath conf) - (_hugsProg, version, conf'') - <- requireProgramVersion verbosity hugsProgram' - (orLaterVersion (Version [2006] [])) conf' - - let comp = Compiler { - compilerId = CompilerId Hugs version, - compilerLanguages = hugsLanguages, - compilerExtensions = hugsLanguageExtensions, - compilerProperties = M.empty - } - compPlatform = Nothing - return (comp, compPlatform, conf'') - - where - hugsProgram' = hugsProgram { programFindVersion = getVersion } - -getVersion :: Verbosity -> FilePath -> IO (Maybe Version) -getVersion verbosity hugsPath = do - (output, _err, exit) <- rawSystemStdInOut verbosity hugsPath [] - Nothing Nothing - (Just (":quit", False)) False - if exit == ExitSuccess - then return $! findVersion output - else return Nothing - - where - findVersion output = do - (monthStr, yearStr) <- selectWords output - year <- convertYear yearStr - month <- convertMonth monthStr - return (Version [year, month] []) - - selectWords output = - case [ (month, year) - | [_,_,"Version:", month, year,_] <- map words (lines output) ] of - [(month, year)] -> Just (month, year) - _ -> Nothing - convertYear year = case reads year of - [(y, [])] | y >= 1999 && y < 2020 -> Just y - _ -> Nothing - convertMonth month = lookup month (zip months [1..]) - months = [ "January", "February", "March", "April", "May", "June", "July" - , "August", "September", "October", "November", "December" ] - -hugsLanguages :: [(Language, Flag)] -hugsLanguages = [(Haskell98, "")] --default is 98 mode - --- | The flags for the supported extensions -hugsLanguageExtensions :: [(Extension, Flag)] -hugsLanguageExtensions = - let doFlag (f, (enable, disable)) = [(EnableExtension f, enable), - (DisableExtension f, disable)] - alwaysOn = ("", ""{- wrong -}) - ext98 = ("-98", ""{- wrong -}) - in concatMap doFlag - [(OverlappingInstances , ("+o", "-o")) - ,(IncoherentInstances , ("+oO", "-O")) - ,(HereDocuments , ("+H", "-H")) - ,(TypeSynonymInstances , ext98) - ,(RecursiveDo , ext98) - ,(ParallelListComp , ext98) - ,(MultiParamTypeClasses , ext98) - ,(FunctionalDependencies , ext98) - ,(Rank2Types , ext98) - ,(PolymorphicComponents , ext98) - ,(ExistentialQuantification , ext98) - ,(ScopedTypeVariables , ext98) - ,(ImplicitParams , ext98) - ,(ExtensibleRecords , ext98) - ,(RestrictedTypeSynonyms , ext98) - ,(FlexibleContexts , ext98) - ,(FlexibleInstances , ext98) - ,(ForeignFunctionInterface , alwaysOn) - ,(EmptyDataDecls , alwaysOn) - ,(CPP , alwaysOn) - ] - -getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration - -> IO PackageIndex -getInstalledPackages verbosity packagedbs conf = do - homedir <- getHomeDirectory - (hugsProg, _) <- requireProgram verbosity hugsProgram conf - let hugsbindir = takeDirectory (programPath hugsProg) - hugslibdir = takeDirectory hugsbindir "lib" "hugs" - dbdirs = nub (concatMap (packageDbPaths homedir hugslibdir) packagedbs) - indexes <- mapM getIndividualDBPackages dbdirs - return $! mconcat indexes - - where - getIndividualDBPackages :: FilePath -> IO PackageIndex - getIndividualDBPackages dbdir = do - pkgdirs <- getPackageDbDirs dbdir - pkgs <- sequence [ getInstalledPackage pkgname pkgdir - | (pkgname, pkgdir) <- pkgdirs ] - let pkgs' = map setInstalledPackageId (catMaybes pkgs) - return (PackageIndex.fromList pkgs') - -packageDbPaths :: FilePath -> FilePath -> PackageDB -> [FilePath] -packageDbPaths home hugslibdir db = case db of - GlobalPackageDB -> [ hugslibdir "packages" - , "/usr/local/lib/hugs/packages" ] - UserPackageDB -> [ home "lib/hugs/packages" ] - SpecificPackageDB path -> [ path ] - -getPackageDbDirs :: FilePath -> IO [(PackageName, FilePath)] -getPackageDbDirs dbdir = do - dbexists <- doesDirectoryExist dbdir - if not dbexists - then return [] - else do - entries <- getDirectoryContents dbdir - pkgdirs <- sequence - [ do pkgdirExists <- doesDirectoryExist pkgdir - return (pkgname, pkgdir, pkgdirExists) - | (entry, Just pkgname) <- [ (entry, simpleParse entry) - | entry <- entries ] - , let pkgdir = dbdir entry ] - return [ (pkgname, pkgdir) | (pkgname, pkgdir, True) <- pkgdirs ] - -getInstalledPackage :: PackageName -> FilePath -> IO (Maybe InstalledPackageInfo) -getInstalledPackage pkgname pkgdir = do - let pkgconfFile = pkgdir "package.conf" - pkgconfExists <- doesFileExist pkgconfFile - - let pathsModule = pkgdir ("Paths_" ++ display pkgname) <.> "hs" - pathsModuleExists <- doesFileExist pathsModule - - case () of - _ | pkgconfExists -> getFullInstalledPackageInfo pkgname pkgconfFile - | pathsModuleExists -> getPhonyInstalledPackageInfo pkgname pathsModule - | otherwise -> return Nothing - -getFullInstalledPackageInfo :: PackageName -> FilePath - -> IO (Maybe InstalledPackageInfo) -getFullInstalledPackageInfo pkgname pkgconfFile = - withUTF8FileContents pkgconfFile $ \contents -> - case parseInstalledPackageInfo contents of - ParseOk _ pkginfo | packageName pkginfo == pkgname - -> return (Just pkginfo) - _ -> return Nothing - --- | This is a backup option for existing versions of Hugs which do not supply --- proper installed package info files for the bundled libs. Instead we look --- for the Paths_pkgname.hs file and extract the package version from that. --- We don't know any other details for such packages, in particular we pretend --- that they have no dependencies. --- -getPhonyInstalledPackageInfo :: PackageName -> FilePath - -> IO (Maybe InstalledPackageInfo) -getPhonyInstalledPackageInfo pkgname pathsModule = do - content <- readFile pathsModule - case extractVersion content of - Nothing -> return Nothing - Just version -> return (Just pkginfo) - where - pkgid = PackageIdentifier pkgname version - pkginfo = emptyInstalledPackageInfo { sourcePackageId = pkgid } - where - -- search through the Paths_pkgname.hs file, looking for a line like: - -- - -- > version = Version {versionBranch = [2,0], versionTags = []} - -- - -- and parse it using 'Read'. Yes we are that evil. - -- - extractVersion content = - case [ version - | ("version":"=":rest) <- map words (lines content) - , (version, []) <- reads (concat rest) ] of - [version] -> Just version - _ -> Nothing - --- Older installed package info files did not have the installedPackageId --- field, so if it is missing then we fill it as the source package ID. -setInstalledPackageId :: InstalledPackageInfo -> InstalledPackageInfo -setInstalledPackageId pkginfo@InstalledPackageInfo { - installedPackageId = InstalledPackageId "", - sourcePackageId = pkgid - } - = pkginfo { - --TODO use a proper named function for the conversion - -- from source package id to installed package id - installedPackageId = InstalledPackageId (display pkgid) - } -setInstalledPackageId pkginfo = pkginfo - --- ----------------------------------------------------------------------------- --- Building - --- |Building a package for Hugs. -buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo - -> Library -> ComponentLocalBuildInfo -> IO () -buildLib verbosity pkg_descr lbi lib _clbi = do - let pref = scratchDir lbi - createDirectoryIfMissingVerbose verbosity True pref - copyFileVerbose verbosity (autogenModulesDir lbi paths_modulename) - (pref paths_modulename) - compileBuildInfo verbosity pref [] (libModules lib) (libBuildInfo lib) lbi - where - paths_modulename = ModuleName.toFilePath (autogenModuleName pkg_descr) - <.> ".hs" - --TODO: switch to using autogenModulesDir as a search dir, rather than - -- always copying the file over. - --- |Building an executable for Hugs. -buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo - -> Executable -> ComponentLocalBuildInfo -> IO () -buildExe verbosity pkg_descr lbi - exe@Executable {modulePath=mainPath, buildInfo=bi} _clbi = do - let pref = scratchDir lbi - createDirectoryIfMissingVerbose verbosity True pref - - let destDir = pref "programs" - let exeMods = otherModules bi - srcMainFile <- findFile (hsSourceDirs bi) mainPath - let exeDir = destDir exeName exe - let destMainFile = exeDir hugsMainFilename exe - copyModule verbosity (EnableExtension CPP `elem` allExtensions bi) bi lbi srcMainFile destMainFile - let destPathsFile = exeDir paths_modulename - copyFileVerbose verbosity (autogenModulesDir lbi paths_modulename) - destPathsFile - compileBuildInfo verbosity exeDir - (maybe [] (hsSourceDirs . libBuildInfo) (library pkg_descr)) exeMods bi lbi - compileFiles verbosity bi lbi exeDir [destMainFile, destPathsFile] - - where - paths_modulename = ModuleName.toFilePath (autogenModuleName pkg_descr) - <.> ".hs" - -compileBuildInfo :: Verbosity - -> FilePath -- ^output directory - -> [FilePath] -- ^library source dirs, if building exes - -> [ModuleName] -- ^Modules - -> BuildInfo - -> LocalBuildInfo - -> IO () ---TODO: should not be using mLibSrcDirs at all -compileBuildInfo verbosity destDir mLibSrcDirs mods bi lbi = do - -- Pass 1: copy or cpp files from build directory to scratch directory - let useCpp = EnableExtension CPP `elem` allExtensions bi - let srcDir = buildDir lbi - srcDirs = nub $ srcDir : hsSourceDirs bi ++ mLibSrcDirs - info verbosity $ "Source directories: " ++ show srcDirs - flip mapM_ mods $ \ m -> do - fs <- findFileWithExtension suffixes srcDirs (ModuleName.toFilePath m) - case fs of - Nothing -> - die ("can't find source for module " ++ display m) - Just srcFile -> do - let ext = takeExtension srcFile - copyModule verbosity useCpp bi lbi srcFile - (destDir ModuleName.toFilePath m <.> ext) - -- Pass 2: compile foreign stubs in scratch directory - stubsFileLists <- fmap catMaybes $ sequence - [ findFileWithExtension suffixes [destDir] (ModuleName.toFilePath modu) - | modu <- mods] - compileFiles verbosity bi lbi destDir stubsFileLists - -suffixes :: [String] -suffixes = ["hs", "lhs"] - --- Copy or cpp a file from the source directory to the build directory. -copyModule :: Verbosity -> Bool -> BuildInfo -> LocalBuildInfo -> FilePath -> FilePath -> IO () -copyModule verbosity cppAll bi lbi srcFile destFile = do - createDirectoryIfMissingVerbose verbosity True (takeDirectory destFile) - (exts, opts, _) <- getOptionsFromSource srcFile - let ghcOpts = [ op | (GHC, ops) <- opts, op <- ops ] - if cppAll || EnableExtension CPP `elem` exts || "-cpp" `elem` ghcOpts then do - runSimplePreProcessor (ppCpp bi lbi) srcFile destFile verbosity - return () - else - copyFileVerbose verbosity srcFile destFile - -compileFiles :: Verbosity -> BuildInfo -> LocalBuildInfo -> FilePath -> [FilePath] -> IO () -compileFiles verbosity bi lbi modDir fileList = do - ffiFileList <- filterM testFFI fileList - unless (null ffiFileList) $ do - notice verbosity "Compiling FFI stubs" - mapM_ (compileFFI verbosity bi lbi modDir) ffiFileList - --- Only compile FFI stubs for a file if it contains some FFI stuff -testFFI :: FilePath -> IO Bool -testFFI file = - withHaskellFile file $ \inp -> - return $! "foreign" `elem` symbols (stripComments False inp) - -compileFFI :: Verbosity -> BuildInfo -> LocalBuildInfo -> FilePath -> FilePath -> IO () -compileFFI verbosity bi lbi modDir file = do - (_, opts, file_incs) <- getOptionsFromSource file - let ghcOpts = [ op | (GHC, ops) <- opts, op <- ops ] - let pkg_incs = ["\"" ++ inc ++ "\"" | inc <- includes bi] - let incs = nub (sort (file_incs ++ includeOpts ghcOpts ++ pkg_incs)) - let pathFlag = "-P" ++ modDir ++ [searchPathSeparator] - let hugsArgs = "-98" : pathFlag : map ("-i" ++) incs - cfiles <- getCFiles file - let cArgs = - ["-I" ++ dir | dir <- includeDirs bi] ++ - ccOptions bi ++ - cfiles ++ - ["-L" ++ dir | dir <- extraLibDirs bi] ++ - ldOptions bi ++ - ["-l" ++ lib | lib <- extraLibs bi] ++ - concat [["-framework", f] | f <- frameworks bi] - rawSystemProgramConf verbosity ffihugsProgram (withPrograms lbi) - (hugsArgs ++ file : cArgs) - -includeOpts :: [String] -> [String] -includeOpts [] = [] -includeOpts ("-#include" : arg : opts) = arg : includeOpts opts -includeOpts (_ : opts) = includeOpts opts - --- get C file names from CFILES pragmas throughout the source file -getCFiles :: FilePath -> IO [String] -getCFiles file = - withHaskellFile file $ \inp -> - let cfiles = - [ normalise cfile - | "{-#" : "CFILES" : rest <- map words - $ lines - $ stripComments True inp - , last rest == "#-}" - , cfile <- init rest] - in seq (length cfiles) (return cfiles) - --- List of terminal symbols in a source file. -symbols :: String -> [String] -symbols cs = case lex cs of - (sym, cs'):_ | not (null sym) -> sym : symbols cs' - _ -> [] - --- Get the non-literate source of a Haskell module. -withHaskellFile :: FilePath -> (String -> IO a) -> IO a -withHaskellFile file action = - withUTF8FileContents file $ \text -> - if ".lhs" `isSuffixOf` file - then either action die (unlit file text) - else action text - --- ------------------------------------------------------------ --- * options in source files --- ------------------------------------------------------------ - --- |Read the initial part of a source file, before any Haskell code, --- and return the contents of any LANGUAGE, OPTIONS and INCLUDE pragmas. -getOptionsFromSource - :: FilePath - -> IO ([Extension], -- LANGUAGE pragma, if any - [(CompilerFlavor,[String])], -- OPTIONS_FOO pragmas - [String] -- INCLUDE pragmas - ) -getOptionsFromSource file = - withHaskellFile file $ - (return $!) - . foldr appendOptions ([],[],[]) . map getOptions - . takeWhileJust . map getPragma - . filter textLine . map (dropWhile isSpace) . lines - . stripComments True - - where textLine [] = False - textLine ('#':_) = False - textLine _ = True - - getPragma :: String -> Maybe [String] - getPragma line = case words line of - ("{-#" : rest) | last rest == "#-}" -> Just (init rest) - _ -> Nothing - - getOptions ("OPTIONS":opts) = ([], [(GHC, opts)], []) - getOptions ("OPTIONS_GHC":opts) = ([], [(GHC, opts)], []) - getOptions ("OPTIONS_NHC98":opts) = ([], [(NHC, opts)], []) - getOptions ("OPTIONS_HUGS":opts) = ([], [(Hugs, opts)], []) - getOptions ("LANGUAGE":ws) = (mapMaybe readExtension ws, [], []) - where readExtension :: String -> Maybe Extension - readExtension w = case reads w of - [(ext, "")] -> Just ext - [(ext, ",")] -> Just ext - _ -> Nothing - getOptions ("INCLUDE":ws) = ([], [], ws) - getOptions _ = ([], [], []) - - appendOptions (exts, opts, incs) (exts', opts', incs') - = (exts++exts', opts++opts', incs++incs') - --- takeWhileJust f = map fromJust . takeWhile isJust -takeWhileJust :: [Maybe a] -> [a] -takeWhileJust (Just x:xs) = x : takeWhileJust xs -takeWhileJust _ = [] - --- |Strip comments from Haskell source. -stripComments - :: Bool -- ^ preserve pragmas? - -> String -- ^ input source text - -> String -stripComments keepPragmas = stripCommentsLevel 0 - where stripCommentsLevel :: Int -> String -> String - stripCommentsLevel 0 ('"':cs) = '"':copyString cs - stripCommentsLevel 0 ('-':'-':cs) = -- FIX: symbols like --> - stripCommentsLevel 0 (dropWhile (/= '\n') cs) - stripCommentsLevel 0 ('{':'-':'#':cs) - | keepPragmas = '{' : '-' : '#' : copyPragma cs - stripCommentsLevel n ('{':'-':cs) = stripCommentsLevel (n+1) cs - stripCommentsLevel 0 (c:cs) = c : stripCommentsLevel 0 cs - stripCommentsLevel n ('-':'}':cs) = stripCommentsLevel (n-1) cs - stripCommentsLevel n (_:cs) = stripCommentsLevel n cs - stripCommentsLevel _ [] = [] - - copyString ('\\':c:cs) = '\\' : c : copyString cs - copyString ('"':cs) = '"' : stripCommentsLevel 0 cs - copyString (c:cs) = c : copyString cs - copyString [] = [] - - copyPragma ('#':'-':'}':cs) = '#' : '-' : '}' : stripCommentsLevel 0 cs - copyPragma (c:cs) = c : copyPragma cs - copyPragma [] = [] - --- ----------------------------------------------------------------------------- --- |Install for Hugs. --- For install, copy-prefix = prefix, but for copy they're different. --- The library goes in \\/lib\/hugs\/packages\/\ --- (i.e. \\/lib\/hugs\/packages\/\ on the target system). --- Each executable goes in \\/lib\/hugs\/programs\/\ --- (i.e. \\/lib\/hugs\/programs\/\ on the target system) --- with a script \\/bin\/\ pointing at --- \\/lib\/hugs\/programs\/\. -install - :: Verbosity -- ^verbosity - -> LocalBuildInfo - -> FilePath -- ^Library install location - -> FilePath -- ^Program install location - -> FilePath -- ^Executable install location - -> FilePath -- ^Program location on target system - -> FilePath -- ^Build location - -> (FilePath,FilePath) -- ^Executable (prefix,suffix) - -> PackageDescription - -> IO () ---FIXME: this script should be generated at build time, just installed at this stage -install verbosity lbi libDir installProgDir binDir targetProgDir buildPref (progprefix,progsuffix) pkg_descr = do - removeDirectoryRecursive libDir `catchIO` \_ -> return () - withLib pkg_descr $ \ lib -> - findModuleFiles [buildPref] hugsInstallSuffixes (libModules lib) - >>= installOrdinaryFiles verbosity libDir - let buildProgDir = buildPref "programs" - when (any (buildable . buildInfo) (executables pkg_descr)) $ - createDirectoryIfMissingVerbose verbosity True binDir - withExe pkg_descr $ \ exe -> do - let bi = buildInfo exe - let theBuildDir = buildProgDir exeName exe - let installDir = installProgDir exeName exe - let targetDir = targetProgDir exeName exe - removeDirectoryRecursive installDir `catchIO` \_ -> return () - findModuleFiles [theBuildDir] hugsInstallSuffixes - (ModuleName.main : autogenModuleName pkg_descr - : otherModules (buildInfo exe)) - >>= installOrdinaryFiles verbosity installDir - let targetName = "\"" ++ (targetDir hugsMainFilename exe) ++ "\"" - let hugsOptions = hcOptions Hugs (buildInfo exe) - ++ languageToFlags (compiler lbi) (defaultLanguage bi) - ++ extensionsToFlags (compiler lbi) (allExtensions bi) - --TODO: also need to consider options, extensions etc of deps - -- see ticket #43 - let baseExeFile = progprefix ++ (exeName exe) ++ progsuffix - let exeFile = case buildOS of - Windows -> binDir baseExeFile <.> ".bat" - _ -> binDir baseExeFile - let script = case buildOS of - Windows -> - let args = hugsOptions ++ [targetName, "%*"] - in unlines ["@echo off", - unwords ("runhugs" : args)] - _ -> - let args = hugsOptions ++ [targetName, "\"$@\""] - in unlines ["#! /bin/sh", - unwords ("runhugs" : args)] - writeFileAtomic exeFile (BS.Char8.pack script) - setFileExecutable exeFile - -hugsInstallSuffixes :: [String] -hugsInstallSuffixes = [".hs", ".lhs", dllExtension] - --- |Filename used by Hugs for the main module of an executable. --- This is a simple filename, so that Hugs will look for any auxiliary --- modules it uses relative to the directory it's in. -hugsMainFilename :: Executable -> FilePath -hugsMainFilename exe = "Main" <.> ext - where ext = takeExtension (modulePath exe) - --- ----------------------------------------------------------------------------- --- Registering - -registerPackage - :: Verbosity - -> InstalledPackageInfo - -> PackageDescription - -> LocalBuildInfo - -> Bool - -> PackageDBStack - -> IO () -registerPackage verbosity installedPkgInfo pkg lbi inplace _packageDbs = do - --TODO: prefer to have it based on the packageDbs, but how do we know - -- the package subdir based on the name? the user can set crazy libsubdir - let installDirs = absoluteInstallDirs pkg lbi NoCopyDest - pkgdir | inplace = buildDir lbi - | otherwise = libdir installDirs - createDirectoryIfMissingVerbose verbosity True pkgdir - writeUTF8File (pkgdir "package.conf") - (showInstalledPackageInfo installedPkgInfo) diff --git a/Distribution/Simple/Install.hs b/Distribution/Simple/Install.hs --- a/Distribution/Simple/Install.hs +++ b/Distribution/Simple/Install.hs @@ -30,14 +30,13 @@ , die, info, notice, warn, matchDirFileGlob ) import Distribution.Simple.Compiler ( CompilerFlavor(..), compilerFlavor ) -import Distribution.Simple.Setup (CopyFlags(..), CopyDest(..), fromFlag) +import Distribution.Simple.Setup (CopyFlags(..), fromFlag) -import qualified Distribution.Simple.GHC as GHC -import qualified Distribution.Simple.NHC as NHC -import qualified Distribution.Simple.JHC as JHC -import qualified Distribution.Simple.LHC as LHC -import qualified Distribution.Simple.Hugs as Hugs -import qualified Distribution.Simple.UHC as UHC +import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.GHCJS as GHCJS +import qualified Distribution.Simple.JHC as JHC +import qualified Distribution.Simple.LHC as LHC +import qualified Distribution.Simple.UHC as UHC import qualified Distribution.Simple.HaskellSuite as HaskellSuite import Control.Monad (when, unless) @@ -51,8 +50,7 @@ ( display ) -- |Perform the \"@.\/setup install@\" and \"@.\/setup copy@\" --- actions. Move files into place based on the prefix argument. FIX: --- nhc isn't implemented yet. +-- actions. Move files into place based on the prefix argument. install :: PackageDescription -- ^information from the .cabal file -> LocalBuildInfo -- ^information from the configure step @@ -67,7 +65,6 @@ libdir = libPref, -- dynlibdir = dynlibPref, --see TODO below datadir = dataPref, - progdir = progPref, docdir = docPref, htmldir = htmlPref, haddockdir = interfacePref, @@ -134,6 +131,10 @@ GHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr withExe pkg_descr $ GHC.installExe verbosity lbi installDirs buildPref (progPrefixPref, progSuffixPref) pkg_descr + GHCJS-> do withLibLBI pkg_descr lbi $ + GHCJS.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr + withExe pkg_descr $ + GHCJS.installExe verbosity lbi installDirs buildPref (progPrefixPref, progSuffixPref) pkg_descr LHC -> do withLibLBI pkg_descr lbi $ LHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr withExe pkg_descr $ @@ -142,12 +143,6 @@ JHC.installLib verbosity libPref buildPref pkg_descr withExe pkg_descr $ JHC.installExe verbosity binPref buildPref (progPrefixPref, progSuffixPref) pkg_descr - Hugs -> do - let targetProgPref = progdir (absoluteInstallDirs pkg_descr lbi NoCopyDest) - let scratchPref = scratchDir lbi - Hugs.install verbosity lbi libPref progPref binPref targetProgPref scratchPref (progPrefixPref, progSuffixPref) pkg_descr - NHC -> do withLibLBI pkg_descr lbi $ NHC.installLib verbosity libPref buildPref (packageId pkg_descr) - withExe pkg_descr $ NHC.installExe verbosity binPref buildPref (progPrefixPref, progSuffixPref) UHC -> do withLib pkg_descr $ UHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr HaskellSuite {} -> withLib pkg_descr $ diff --git a/Distribution/Simple/InstallDirs.hs b/Distribution/Simple/InstallDirs.hs --- a/Distribution/Simple/InstallDirs.hs +++ b/Distribution/Simple/InstallDirs.hs @@ -1,4 +1,6 @@ {-# LANGUAGE CPP, ForeignFunctionInterface #-} +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.InstallDirs @@ -37,23 +39,26 @@ platformTemplateEnv, compilerTemplateEnv, packageTemplateEnv, + abiTemplateEnv, installDirsTemplateEnv, ) where +import Data.Binary (Binary) import Data.List (isPrefixOf) import Data.Maybe (fromMaybe) import Data.Monoid (Monoid(..)) +import GHC.Generics (Generic) import System.Directory (getAppUserDataDirectory) import System.FilePath ((), isPathSeparator, pathSeparator) import System.FilePath (dropDrive) import Distribution.Package - ( PackageIdentifier, packageName, packageVersion ) + ( PackageIdentifier, PackageKey, packageName, packageVersion ) import Distribution.System ( OS(..), buildOS, Platform(..) ) import Distribution.Compiler - ( CompilerId, CompilerFlavor(..) ) + ( AbiTag(..), abiTagString, CompilerInfo(..), CompilerFlavor(..) ) import Distribution.Text ( display ) @@ -80,7 +85,6 @@ libsubdir :: dir, dynlibdir :: dir, libexecdir :: dir, - progdir :: dir, includedir :: dir, datadir :: dir, datasubdir :: dir, @@ -89,8 +93,10 @@ htmldir :: dir, haddockdir :: dir, sysconfdir :: dir - } deriving (Read, Show) + } deriving (Generic, Read, Show) +instance Binary dir => Binary (InstallDirs dir) + instance Functor InstallDirs where fmap f dirs = InstallDirs { prefix = f (prefix dirs), @@ -99,7 +105,6 @@ libsubdir = f (libsubdir dirs), dynlibdir = f (dynlibdir dirs), libexecdir = f (libexecdir dirs), - progdir = f (progdir dirs), includedir = f (includedir dirs), datadir = f (datadir dirs), datasubdir = f (datasubdir dirs), @@ -118,7 +123,6 @@ libsubdir = mempty, dynlibdir = mempty, libexecdir = mempty, - progdir = mempty, includedir = mempty, datadir = mempty, datasubdir = mempty, @@ -141,7 +145,6 @@ libsubdir = libsubdir a `combine` libsubdir b, dynlibdir = dynlibdir a `combine` dynlibdir b, libexecdir = libexecdir a `combine` libexecdir b, - progdir = progdir a `combine` progdir b, includedir = includedir a `combine` includedir b, datadir = datadir a `combine` datadir b, datasubdir = datasubdir a `combine` datasubdir b, @@ -177,7 +180,7 @@ -- users to be able to configure @--libdir=\/usr\/lib64@ for example but -- because by default we want to support installing multiple versions of -- packages and building the same package for multiple compilers we append the --- libsubdir to get: @\/usr\/lib64\/$pkgid\/$compiler@. +-- libsubdir to get: @\/usr\/lib64\/$pkgkey\/$compiler@. -- -- An additional complication is the need to support relocatable packages on -- systems which support such things, like Windows. @@ -207,22 +210,20 @@ bindir = "$prefix" "bin", libdir = installLibDir, libsubdir = case comp of - Hugs -> "hugs" "packages" "$pkg" JHC -> "$compiler" LHC -> "$compiler" UHC -> "$pkgid" - _other -> "$arch-$os-$compiler" "$pkgid", + _other -> "$abi" "$pkgkey", dynlibdir = "$libdir", libexecdir = case buildOS of - Windows -> "$prefix" "$pkgid" + Windows -> "$prefix" "$pkgkey" _other -> "$prefix" "libexec", - progdir = "$libdir" "hugs" "programs", includedir = "$libdir" "$libsubdir" "include", datadir = case buildOS of Windows -> "$prefix" _other -> "$prefix" "share", - datasubdir = "$arch-$os-$compiler" "$pkgid", - docdir = "$datadir" "doc" "$arch-$os-$compiler" "$pkgid", + datasubdir = "$abi" "$pkgid", + docdir = "$datadir" "doc" "$abi" "$pkgid", mandir = "$datadir" "man", htmldir = "$docdir" "html", haddockdir = "$htmldir", @@ -256,7 +257,6 @@ libsubdir = subst libsubdir [], dynlibdir = subst dynlibdir [prefixVar, bindirVar, libdirVar], libexecdir = subst libexecdir prefixBinLibVars, - progdir = subst progdir prefixBinLibVars, includedir = subst includedir prefixBinLibVars, datadir = subst datadir prefixBinLibVars, datasubdir = subst datasubdir [], @@ -283,10 +283,14 @@ -- | Convert from abstract install directories to actual absolute ones by -- substituting for all the variables in the abstract paths, to get real -- absolute path. -absoluteInstallDirs :: PackageIdentifier -> CompilerId -> CopyDest -> Platform +absoluteInstallDirs :: PackageIdentifier + -> PackageKey + -> CompilerInfo + -> CopyDest + -> Platform -> InstallDirs PathTemplate -> InstallDirs FilePath -absoluteInstallDirs pkgId compilerId copydest platform dirs = +absoluteInstallDirs pkgId pkg_key compilerId copydest platform dirs = (case copydest of CopyTo destdir -> fmap ((destdir ) . dropDrive) _ -> id) @@ -294,7 +298,7 @@ . fmap fromPathTemplate $ substituteInstallDirTemplates env dirs where - env = initialPathTemplateEnv pkgId compilerId platform + env = initialPathTemplateEnv pkgId pkg_key compilerId platform -- |The location prefix for the /copy/ command. @@ -309,10 +313,13 @@ -- prevents us from making a relocatable package (also known as a \"prefix -- independent\" package). -- -prefixRelativeInstallDirs :: PackageIdentifier -> CompilerId -> Platform +prefixRelativeInstallDirs :: PackageIdentifier + -> PackageKey + -> CompilerInfo + -> Platform -> InstallDirTemplates -> InstallDirs (Maybe FilePath) -prefixRelativeInstallDirs pkgId compilerId platform dirs = +prefixRelativeInstallDirs pkgId pkg_key compilerId platform dirs = fmap relative . appendSubdirs combinePathTemplate $ -- substitute the path template into each other, except that we map @@ -322,7 +329,7 @@ prefix = PathTemplate [Variable PrefixVar] } where - env = initialPathTemplateEnv pkgId compilerId platform + env = initialPathTemplateEnv pkgId pkg_key compilerId platform -- If it starts with $prefix then it's relative and produce the relative -- path by stripping off $prefix/ or $prefix @@ -339,13 +346,17 @@ -- | An abstract path, possibly containing variables that need to be -- substituted for to get a real 'FilePath'. -- -newtype PathTemplate = PathTemplate [PathComponent] +newtype PathTemplate = PathTemplate [PathComponent] deriving (Eq, Generic, Ord) +instance Binary PathTemplate + data PathComponent = Ordinary FilePath | Variable PathTemplateVariable - deriving Eq + deriving (Eq, Ord, Generic) +instance Binary PathComponent + data PathTemplateVariable = PrefixVar -- ^ The @$prefix@ path variable | BindirVar -- ^ The @$bindir@ path variable @@ -358,16 +369,21 @@ | PkgNameVar -- ^ The @$pkg@ package name path variable | PkgVerVar -- ^ The @$version@ package version path variable | PkgIdVar -- ^ The @$pkgid@ package Id path variable, eg @foo-1.0@ + | PkgKeyVar -- ^ The @$pkgkey@ package key path variable | CompilerVar -- ^ The compiler name and version, eg @ghc-6.6.1@ | OSVar -- ^ The operating system name, eg @windows@ or @linux@ | ArchVar -- ^ The CPU architecture name, eg @i386@ or @x86_64@ + | AbiVar -- ^ The Compiler's ABI identifier, $arch-$os-$compiler-$abitag + | AbiTagVar -- ^ The optional ABI tag for the compiler | ExecutableNameVar -- ^ The executable name; used in shell wrappers | TestSuiteNameVar -- ^ The name of the test suite being run | TestSuiteResultVar -- ^ The result of the test suite being run, eg -- @pass@, @fail@, or @error@. | BenchmarkNameVar -- ^ The name of the benchmark being run - deriving Eq + deriving (Eq, Ord, Generic) +instance Binary PathTemplateVariable + type PathTemplateEnv = [(PathTemplateVariable, PathTemplate)] -- | Convert a 'FilePath' to a 'PathTemplate' including any template vars. @@ -395,23 +411,28 @@ Nothing -> [component] -- | The initial environment has all the static stuff but no paths -initialPathTemplateEnv :: PackageIdentifier -> CompilerId -> Platform +initialPathTemplateEnv :: PackageIdentifier + -> PackageKey + -> CompilerInfo + -> Platform -> PathTemplateEnv -initialPathTemplateEnv pkgId compilerId platform = - packageTemplateEnv pkgId - ++ compilerTemplateEnv compilerId +initialPathTemplateEnv pkgId pkg_key compiler platform = + packageTemplateEnv pkgId pkg_key + ++ compilerTemplateEnv compiler ++ platformTemplateEnv platform + ++ abiTemplateEnv compiler platform -packageTemplateEnv :: PackageIdentifier -> PathTemplateEnv -packageTemplateEnv pkgId = +packageTemplateEnv :: PackageIdentifier -> PackageKey -> PathTemplateEnv +packageTemplateEnv pkgId pkg_key = [(PkgNameVar, PathTemplate [Ordinary $ display (packageName pkgId)]) ,(PkgVerVar, PathTemplate [Ordinary $ display (packageVersion pkgId)]) + ,(PkgKeyVar, PathTemplate [Ordinary $ display pkg_key]) ,(PkgIdVar, PathTemplate [Ordinary $ display pkgId]) ] -compilerTemplateEnv :: CompilerId -> PathTemplateEnv -compilerTemplateEnv compilerId = - [(CompilerVar, PathTemplate [Ordinary $ display compilerId]) +compilerTemplateEnv :: CompilerInfo -> PathTemplateEnv +compilerTemplateEnv compiler = + [(CompilerVar, PathTemplate [Ordinary $ display (compilerInfoId compiler)]) ] platformTemplateEnv :: Platform -> PathTemplateEnv @@ -420,6 +441,16 @@ ,(ArchVar, PathTemplate [Ordinary $ display arch]) ] +abiTemplateEnv :: CompilerInfo -> Platform -> PathTemplateEnv +abiTemplateEnv compiler (Platform arch os) = + [(AbiVar, PathTemplate [Ordinary $ display arch ++ '-':display os ++ + '-':display (compilerInfoId compiler) ++ + case compilerInfoAbiTag compiler of + NoAbiTag -> "" + AbiTag tag -> '-':tag]) + ,(AbiTagVar, PathTemplate [Ordinary $ abiTagString (compilerInfoAbiTag compiler)]) + ] + installDirsTemplateEnv :: InstallDirs PathTemplate -> PathTemplateEnv installDirsTemplateEnv dirs = [(PrefixVar, prefix dirs) @@ -444,6 +475,7 @@ instance Show PathTemplateVariable where show PrefixVar = "prefix" + show PkgKeyVar = "pkgkey" show BindirVar = "bindir" show LibdirVar = "libdir" show LibsubdirVar = "libsubdir" @@ -457,6 +489,8 @@ show CompilerVar = "compiler" show OSVar = "os" show ArchVar = "arch" + show AbiTagVar = "abitag" + show AbiVar = "abi" show ExecutableNameVar = "executablename" show TestSuiteNameVar = "test-suite" show TestSuiteResultVar = "result" @@ -468,6 +502,7 @@ [ (var, drop (length varStr) s) | (varStr, var) <- vars , varStr `isPrefixOf` s ] + -- NB: order matters! Longer strings first where vars = [("prefix", PrefixVar) ,("bindir", BindirVar) ,("libdir", LibdirVar) @@ -477,11 +512,14 @@ ,("docdir", DocdirVar) ,("htmldir", HtmldirVar) ,("pkgid", PkgIdVar) + ,("pkgkey", PkgKeyVar) ,("pkg", PkgNameVar) ,("version", PkgVerVar) ,("compiler", CompilerVar) ,("os", OSVar) ,("arch", ArchVar) + ,("abitag", AbiTagVar) + ,("abi", AbiVar) ,("executablename", ExecutableNameVar) ,("test-suite", TestSuiteNameVar) ,("result", TestSuiteResultVar) @@ -548,7 +586,13 @@ -- csidl_PROGRAM_FILES_COMMON :: CInt -- csidl_PROGRAM_FILES_COMMON = 0x002b -foreign import stdcall unsafe "shlobj.h SHGetFolderPathW" +#ifdef x86_64_HOST_ARCH +#define CALLCONV ccall +#else +#define CALLCONV stdcall +#endif + +foreign import CALLCONV unsafe "shlobj.h SHGetFolderPathW" c_SHGetFolderPath :: Ptr () -> CInt -> Ptr () diff --git a/Distribution/Simple/JHC.hs b/Distribution/Simple/JHC.hs --- a/Distribution/Simple/JHC.hs +++ b/Distribution/Simple/JHC.hs @@ -22,14 +22,14 @@ import Distribution.InstalledPackageInfo ( emptyInstalledPackageInfo, ) import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo -import Distribution.Simple.PackageIndex (PackageIndex) +import Distribution.Simple.PackageIndex (InstalledPackageIndex) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) ) import Distribution.Simple.BuildPaths ( autogenModulesDir, exeExtension ) import Distribution.Simple.Compiler - ( CompilerFlavor(..), CompilerId(..), Compiler(..) + ( CompilerFlavor(..), CompilerId(..), Compiler(..), AbiTag(..) , PackageDBStack, Flag, languageToFlags, extensionsToFlags ) import Language.Haskell.Extension ( Language(Haskell98), Extension(..), KnownExtension(..)) @@ -76,6 +76,8 @@ let Just version = programVersion jhcProg comp = Compiler { compilerId = CompilerId JHC version, + compilerAbiTag = NoAbiTag, + compilerCompat = [], compilerLanguages = jhcLanguages, compilerExtensions = jhcLanguageExtensions, compilerProperties = M.empty @@ -100,7 +102,7 @@ ] getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration - -> IO PackageIndex + -> IO InstalledPackageIndex getInstalledPackages verbosity _packageDBs conf = do -- jhc --list-libraries lists all available libraries. -- How shall I find out, whether they are global or local diff --git a/Distribution/Simple/LHC.hs b/Distribution/Simple/LHC.hs --- a/Distribution/Simple/LHC.hs +++ b/Distribution/Simple/LHC.hs @@ -35,13 +35,15 @@ buildLib, buildExe, installLib, installExe, registerPackage, + hcPkgInfo, ghcOptions, ghcVerbosityOptions ) where import Distribution.PackageDescription as PD ( PackageDescription(..), BuildInfo(..), Executable(..) - , Library(..), libModules, hcOptions, usedExtensions, allExtensions ) + , Library(..), libModules, hcOptions, hcProfOptions, hcSharedOptions + , usedExtensions, allExtensions ) import Distribution.InstalledPackageInfo ( InstalledPackageInfo , parseInstalledPackageInfo ) @@ -72,7 +74,7 @@ import qualified Distribution.Simple.Program.HcPkg as HcPkg import Distribution.Simple.Compiler ( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion - , OptimisationLevel(..), PackageDB(..), PackageDBStack + , OptimisationLevel(..), PackageDB(..), PackageDBStack, AbiTag(..) , Flag, languageToFlags, extensionsToFlags ) import Distribution.Version ( Version(..), orLaterVersion ) @@ -125,6 +127,8 @@ let comp = Compiler { compilerId = CompilerId LHC lhcVersion, + compilerAbiTag = NoAbiTag, + compilerCompat = [], compilerLanguages = languages, compilerExtensions = extensions, compilerProperties = M.empty @@ -218,7 +222,7 @@ | Just ext <- map readExtension (lines exts) ] getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration - -> IO PackageIndex + -> IO InstalledPackageIndex getInstalledPackages verbosity packagedbs conf = do checkPackageDbStack packagedbs pkgss <- getInstalledPackages' lhcPkg verbosity packagedbs conf @@ -344,13 +348,13 @@ "-hisuf", "p_hi", "-osuf", "p_o" ] - ++ ghcProfOptions libBi + ++ hcProfOptions GHC libBi ghcArgsShared = ghcArgs ++ ["-dynamic", "-hisuf", "dyn_hi", "-osuf", "dyn_o", "-fPIC" ] - ++ ghcSharedOptions libBi + ++ hcSharedOptions GHC libBi unless (null (libModules lib)) $ do ifVanillaLib forceVanillaLib (runGhcProg $ lhcWrap ghcArgs) ifProfLib (runGhcProg $ lhcWrap ghcArgsProf) @@ -529,7 +533,7 @@ then ["-prof", "-hisuf", "p_hi", "-osuf", "p_o" - ] ++ ghcProfOptions exeBi + ] ++ hcProfOptions GHC exeBi else [] -- For building exe's for profiling that use TH we actually @@ -781,6 +785,15 @@ -> Bool -> PackageDBStack -> IO () -registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do - let Just lhcPkg = lookupProgram lhcPkgProgram (withPrograms lbi) - HcPkg.reregister verbosity lhcPkg packageDbs (Right installedPkgInfo) +registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = + HcPkg.reregister (hcPkgInfo $ withPrograms lbi) verbosity packageDbs + (Right installedPkgInfo) + +hcPkgInfo :: ProgramConfiguration -> HcPkg.HcPkgInfo +hcPkgInfo conf = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = lhcPkgProg + , HcPkg.noPkgDbStack = False + , HcPkg.noVerboseFlag = False + , HcPkg.flagPackageConf = False + } + where + Just lhcPkgProg = lookupProgram lhcPkgProgram conf diff --git a/Distribution/Simple/LocalBuildInfo.hs b/Distribution/Simple/LocalBuildInfo.hs --- a/Distribution/Simple/LocalBuildInfo.hs +++ b/Distribution/Simple/LocalBuildInfo.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.LocalBuildInfo @@ -40,6 +42,7 @@ allComponentsInBuildOrder, componentsInBuildOrder, checkComponentsCyclic, + depLibraryPaths, withAllComponentsInBuildOrder, withComponentsInBuildOrder, @@ -60,28 +63,41 @@ substPathTemplate, ) import qualified Distribution.Simple.InstallDirs as InstallDirs import Distribution.Simple.Program (ProgramConfiguration) +import Distribution.InstalledPackageInfo (InstalledPackageInfo) import Distribution.PackageDescription ( PackageDescription(..), withLib, Library(libBuildInfo), withExe , Executable(exeName, buildInfo), withTest, TestSuite(..) - , BuildInfo(buildable), Benchmark(..) ) + , BuildInfo(buildable), Benchmark(..), ModuleRenaming(..) ) +import qualified Distribution.InstalledPackageInfo as Installed import Distribution.Package - ( PackageId, Package(..), InstalledPackageId(..) ) + ( PackageId, Package(..), InstalledPackageId(..), PackageKey + , PackageName ) import Distribution.Simple.Compiler - ( Compiler(..), PackageDBStack, OptimisationLevel ) + ( Compiler, compilerInfo, PackageDBStack, DebugInfoLevel + , OptimisationLevel ) import Distribution.Simple.PackageIndex - ( PackageIndex ) + ( InstalledPackageIndex, allPackages ) +import Distribution.ModuleName ( ModuleName ) import Distribution.Simple.Setup ( ConfigFlags ) +import Distribution.Simple.Utils + ( shortRelativePath ) import Distribution.Text ( display ) import Distribution.System - ( Platform ) -import Data.List (nub, find) -import Data.Graph -import Data.Tree (flatten) + ( Platform (..) ) + import Data.Array ((!)) +import Data.Binary (Binary) +import Data.Graph +import Data.List (nub, find, stripPrefix) import Data.Maybe +import Data.Tree (flatten) +import GHC.Generics (Generic) +import Data.Map (Map) +import System.Directory (doesDirectoryExist, canonicalizePath) + -- | Data cached after configuration step. See also -- 'Distribution.Simple.Setup.ConfigFlags'. data LocalBuildInfo = LocalBuildInfo { @@ -101,13 +117,10 @@ -- ^ The platform we're building for buildDir :: FilePath, -- ^ Where to build the package. - --TODO: eliminate hugs's scratchDir, use builddir - scratchDir :: FilePath, - -- ^ Where to put the result of the Hugs build. componentsConfigs :: [(ComponentName, ComponentLocalBuildInfo, [ComponentName])], -- ^ All the components to build, ordered by topological sort, and with their dependencies -- over the intrapackage dependency graph - installedPkgs :: PackageIndex, + installedPkgs :: InstalledPackageIndex, -- ^ All the info about the installed packages that the -- current package depends on (directly or indirectly). pkgDescrFile :: Maybe FilePath, @@ -115,6 +128,10 @@ localPkgDescr :: PackageDescription, -- ^ The resolved package description, that does not contain -- any conditionals. + pkgKey :: PackageKey, + -- ^ The package key for the current build, calculated from + -- the package ID and the dependency graph. + instantiatedWith :: [(ModuleName, (InstalledPackageInfo, ModuleName))], withPrograms :: ProgramConfiguration, -- ^Location and args for all programs withPackageDB :: PackageDBStack, -- ^What package database to use, global\/user withVanillaLib:: Bool, -- ^Whether to build normal libs. @@ -123,14 +140,18 @@ withDynExe :: Bool, -- ^Whether to link executables dynamically withProfExe :: Bool, -- ^Whether to build executables for profiling. withOptimization :: OptimisationLevel, -- ^Whether to build with optimization (if available). + withDebugInfo :: DebugInfoLevel, -- ^Whether to emit debug info (if available). withGHCiLib :: Bool, -- ^Whether to build libs suitable for use with GHCi. splitObjs :: Bool, -- ^Use -split-objs with GHC, if available stripExes :: Bool, -- ^Whether to strip executables during install stripLibs :: Bool, -- ^Whether to strip libraries during install progPrefix :: PathTemplate, -- ^Prefix to be prepended to installed executables - progSuffix :: PathTemplate -- ^Suffix to be appended to installed executables - } deriving (Read, Show) + progSuffix :: PathTemplate, -- ^Suffix to be appended to installed executables + relocatable :: Bool -- ^Whether to build a relocatable package + } deriving (Generic, Read, Show) +instance Binary LocalBuildInfo + -- | External package dependencies for the package as a whole. This is the -- union of the individual 'componentPackageDeps', less any internal deps. externalPackageDeps :: LocalBuildInfo -> [(InstalledPackageId, PackageId)] @@ -164,8 +185,10 @@ | CExeName String | CTestName String | CBenchName String - deriving (Show, Eq, Ord, Read) + deriving (Eq, Generic, Ord, Read, Show) +instance Binary ComponentName + showComponentName :: ComponentName -> String showComponentName CLibName = "library" showComponentName (CExeName name) = "executable '" ++ name ++ "'" @@ -179,19 +202,26 @@ -- satisfied in terms of version ranges. This field fixes those dependencies -- to the specific versions available on this machine for this compiler. componentPackageDeps :: [(InstalledPackageId, PackageId)], + componentExposedModules :: [Installed.ExposedModule], + componentPackageRenaming :: Map PackageName ModuleRenaming, componentLibraries :: [LibraryName] } | ExeComponentLocalBuildInfo { - componentPackageDeps :: [(InstalledPackageId, PackageId)] + componentPackageDeps :: [(InstalledPackageId, PackageId)], + componentPackageRenaming :: Map PackageName ModuleRenaming } | TestComponentLocalBuildInfo { - componentPackageDeps :: [(InstalledPackageId, PackageId)] + componentPackageDeps :: [(InstalledPackageId, PackageId)], + componentPackageRenaming :: Map PackageName ModuleRenaming } | BenchComponentLocalBuildInfo { - componentPackageDeps :: [(InstalledPackageId, PackageId)] + componentPackageDeps :: [(InstalledPackageId, PackageId)], + componentPackageRenaming :: Map PackageName ModuleRenaming } - deriving (Read, Show) + deriving (Generic, Read, Show) +instance Binary ComponentLocalBuildInfo + foldComponent :: (Library -> a) -> (Executable -> a) -> (TestSuite -> a) @@ -204,8 +234,10 @@ foldComponent _ _ _ f (CBench bch) = f bch data LibraryName = LibraryName String - deriving (Read, Show) + deriving (Generic, Read, Show) +instance Binary LibraryName + componentBuildInfo :: Component -> BuildInfo componentBuildInfo = foldComponent libBuildInfo buildInfo testBuildInfo benchmarkBuildInfo @@ -378,7 +410,63 @@ [] -> Nothing (c:_) -> Just (map vertexToNode c) +-- | Determine the directories containing the dynamic libraries of the +-- transitive dependencies of the component we are building. +-- +-- When wanted, and possible, returns paths relative to the installDirs 'prefix' +depLibraryPaths :: Bool -- ^ Building for inplace? + -> Bool -- ^ Generate prefix-relative library paths + -> LocalBuildInfo + -> ComponentLocalBuildInfo -- ^ Component that is being built + -> IO [FilePath] +depLibraryPaths inplace relative lbi clbi = do + let pkgDescr = localPkgDescr lbi + installDirs = absoluteInstallDirs pkgDescr lbi NoCopyDest + executable = case clbi of + ExeComponentLocalBuildInfo {} -> True + _ -> False + relDir | executable = bindir installDirs + | otherwise = libdir installDirs + let hasInternalDeps = not $ null + $ [ pkgid + | (_,pkgid) <- componentPackageDeps clbi + , internal pkgid + ] + + let ipkgs = allPackages (installedPkgs lbi) + allDepLibDirs = concatMap Installed.libraryDirs ipkgs + internalLib + | inplace = buildDir lbi + | otherwise = libdir installDirs + allDepLibDirs' = if hasInternalDeps + then internalLib : allDepLibDirs + else allDepLibDirs + allDepLibDirsC <- mapM canonicalizePathNoFail allDepLibDirs' + + let p = prefix installDirs + prefixRelative l = isJust (stripPrefix p l) + libPaths + | relative && + prefixRelative relDir = map (\l -> + if prefixRelative l + then shortRelativePath relDir l + else l + ) allDepLibDirsC + | otherwise = allDepLibDirsC + + return libPaths + where + internal pkgid = pkgid == packageId (localPkgDescr lbi) + -- 'canonicalizePath' fails on UNIX when the directory does not exists. + -- So just don't canonicalize when it doesn't exist. + canonicalizePathNoFail p = do + exists <- doesDirectoryExist p + if exists + then canonicalizePath p + else return p + + -- ----------------------------------------------------------------------------- -- Wrappers for a couple functions from InstallDirs @@ -388,7 +476,8 @@ absoluteInstallDirs pkg lbi copydest = InstallDirs.absoluteInstallDirs (packageId pkg) - (compilerId (compiler lbi)) + (pkgKey lbi) + (compilerInfo (compiler lbi)) copydest (hostPlatform lbi) (installDirTemplates lbi) @@ -399,7 +488,8 @@ prefixRelativeInstallDirs pkg_descr lbi = InstallDirs.prefixRelativeInstallDirs (packageId pkg_descr) - (compilerId (compiler lbi)) + (pkgKey lbi) + (compilerInfo (compiler lbi)) (hostPlatform lbi) (installDirTemplates lbi) @@ -409,5 +499,6 @@ . ( InstallDirs.substPathTemplate env ) where env = initialPathTemplateEnv pkgid - (compilerId (compiler lbi)) + (pkgKey lbi) + (compilerInfo (compiler lbi)) (hostPlatform lbi) diff --git a/Distribution/Simple/NHC.hs b/Distribution/Simple/NHC.hs deleted file mode 100644 --- a/Distribution/Simple/NHC.hs +++ /dev/null @@ -1,406 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Distribution.Simple.NHC --- Copyright : Isaac Jones 2003-2006 --- Duncan Coutts 2009 --- License : BSD3 --- --- Maintainer : cabal-devel@haskell.org --- Portability : portable --- --- This module contains most of the NHC-specific code for configuring, building --- and installing packages. - -module Distribution.Simple.NHC ( - configure, - getInstalledPackages, - buildLib, - buildExe, - installLib, - installExe, - ) where - -import Distribution.Package - ( PackageName, PackageIdentifier(..), InstalledPackageId(..) - , packageName ) -import Distribution.InstalledPackageInfo - ( InstalledPackageInfo - , InstalledPackageInfo_( InstalledPackageInfo, installedPackageId - , sourcePackageId ) - , emptyInstalledPackageInfo, parseInstalledPackageInfo ) -import Distribution.PackageDescription - ( PackageDescription(..), BuildInfo(..), Library(..), Executable(..) - , hcOptions, usedExtensions ) -import Distribution.ModuleName (ModuleName) -import qualified Distribution.ModuleName as ModuleName -import Distribution.Simple.LocalBuildInfo - ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) ) -import Distribution.Simple.BuildPaths - ( mkLibName, objExtension, exeExtension ) -import Distribution.Simple.Compiler - ( CompilerFlavor(..), CompilerId(..), Compiler(..) - , Flag, languageToFlags, extensionsToFlags - , PackageDB(..), PackageDBStack ) -import qualified Distribution.Simple.PackageIndex as PackageIndex -import Distribution.Simple.PackageIndex (PackageIndex) -import Language.Haskell.Extension - ( Language(Haskell98), Extension(..), KnownExtension(..) ) -import Distribution.Simple.Program - ( ProgramConfiguration, userMaybeSpecifyPath, programPath - , requireProgram, requireProgramVersion, lookupProgram - , nhcProgram, hmakeProgram, ldProgram, arProgram - , rawSystemProgramConf ) -import Distribution.Simple.Utils - ( die, info, findFileWithExtension, findModuleFiles - , installOrdinaryFile, installExecutableFile, installOrdinaryFiles - , createDirectoryIfMissingVerbose, withUTF8FileContents ) -import Distribution.Version - ( Version(..), orLaterVersion ) -import Distribution.Verbosity -import Distribution.Text - ( display, simpleParse ) -import Distribution.ParseUtils - ( ParseResult(..) ) - -import System.FilePath - ( (), (<.>), normalise, takeDirectory, dropExtension ) -import System.Directory - ( doesFileExist, doesDirectoryExist, getDirectoryContents - , removeFile, getHomeDirectory ) - -import Data.Char ( toLower ) -import Data.List ( nub ) -import Data.Maybe ( catMaybes ) -import qualified Data.Map as M ( empty ) -import Data.Monoid ( Monoid(..) ) -import Control.Monad ( when, unless ) -import Distribution.Compat.Exception -import Distribution.System ( Platform ) - --- ----------------------------------------------------------------------------- --- Configuring - -configure :: Verbosity -> Maybe FilePath -> Maybe FilePath - -> ProgramConfiguration -> IO (Compiler, Maybe Platform, ProgramConfiguration) -configure verbosity hcPath _hcPkgPath conf = do - - (_nhcProg, nhcVersion, conf') <- - requireProgramVersion verbosity nhcProgram - (orLaterVersion (Version [1,20] [])) - (userMaybeSpecifyPath "nhc98" hcPath conf) - - (_hmakeProg, _hmakeVersion, conf'') <- - requireProgramVersion verbosity hmakeProgram - (orLaterVersion (Version [3,13] [])) conf' - (_ldProg, conf''') <- requireProgram verbosity ldProgram conf'' - (_arProg, conf'''') <- requireProgram verbosity arProgram conf''' - - --TODO: put this stuff in a monad so we can say just: - -- requireProgram hmakeProgram (orLaterVersion (Version [3,13] [])) - -- requireProgram ldProgram anyVersion - -- requireProgram ldPrograrProgramam anyVersion - -- unless (null (cSources bi)) $ requireProgram ccProgram anyVersion - - let comp = Compiler { - compilerId = CompilerId NHC nhcVersion, - compilerLanguages = nhcLanguages, - compilerExtensions = nhcLanguageExtensions, - compilerProperties = M.empty - } - compPlatform = Nothing - return (comp, compPlatform, conf'''') - -nhcLanguages :: [(Language, Flag)] -nhcLanguages = [(Haskell98, "-98")] - --- | The flags for the supported extensions -nhcLanguageExtensions :: [(Extension, Flag)] -nhcLanguageExtensions = - -- TODO: pattern guards in 1.20 - -- NHC doesn't enforce the monomorphism restriction at all. - -- Technically it therefore doesn't support MonomorphismRestriction, - -- but that would mean it doesn't support Haskell98, so we pretend - -- that it does. - [(EnableExtension MonomorphismRestriction, "") - ,(DisableExtension MonomorphismRestriction, "") - -- Similarly, I assume the FFI is always on - ,(EnableExtension ForeignFunctionInterface, "") - ,(DisableExtension ForeignFunctionInterface, "") - -- Similarly, I assume existential quantification is always on - ,(EnableExtension ExistentialQuantification, "") - ,(DisableExtension ExistentialQuantification, "") - -- Similarly, I assume empty data decls is always on - ,(EnableExtension EmptyDataDecls, "") - ,(DisableExtension EmptyDataDecls, "") - ,(EnableExtension NamedFieldPuns, "-puns") - ,(DisableExtension NamedFieldPuns, "-nopuns") - -- CPP can't actually be turned off, but we pretend that it can - ,(EnableExtension CPP, "-cpp") - ,(DisableExtension CPP, "") - ] - -getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration - -> IO PackageIndex -getInstalledPackages verbosity packagedbs conf = do - homedir <- getHomeDirectory - (nhcProg, _) <- requireProgram verbosity nhcProgram conf - let bindir = takeDirectory (programPath nhcProg) - incdir = takeDirectory bindir "include" "nhc98" - dbdirs = nub (concatMap (packageDbPaths homedir incdir) packagedbs) - indexes <- mapM getIndividualDBPackages dbdirs - return $! mconcat indexes - - where - getIndividualDBPackages :: FilePath -> IO PackageIndex - getIndividualDBPackages dbdir = do - pkgdirs <- getPackageDbDirs dbdir - pkgs <- sequence [ getInstalledPackage pkgname pkgdir - | (pkgname, pkgdir) <- pkgdirs ] - let pkgs' = map setInstalledPackageId (catMaybes pkgs) - return (PackageIndex.fromList pkgs') - -packageDbPaths :: FilePath -> FilePath -> PackageDB -> [FilePath] -packageDbPaths _home incdir db = case db of - GlobalPackageDB -> [ incdir "packages" ] - UserPackageDB -> [] --TODO any standard per-user db? - SpecificPackageDB path -> [ path ] - -getPackageDbDirs :: FilePath -> IO [(PackageName, FilePath)] -getPackageDbDirs dbdir = do - dbexists <- doesDirectoryExist dbdir - if not dbexists - then return [] - else do - entries <- getDirectoryContents dbdir - pkgdirs <- sequence - [ do pkgdirExists <- doesDirectoryExist pkgdir - return (pkgname, pkgdir, pkgdirExists) - | (entry, Just pkgname) <- [ (entry, simpleParse entry) - | entry <- entries ] - , let pkgdir = dbdir entry ] - return [ (pkgname, pkgdir) | (pkgname, pkgdir, True) <- pkgdirs ] - -getInstalledPackage :: PackageName -> FilePath -> IO (Maybe InstalledPackageInfo) -getInstalledPackage pkgname pkgdir = do - let pkgconfFile = pkgdir "package.conf" - pkgconfExists <- doesFileExist pkgconfFile - - let cabalFile = pkgdir <.> "cabal" - cabalExists <- doesFileExist cabalFile - - case () of - _ | pkgconfExists -> getFullInstalledPackageInfo pkgname pkgconfFile - | cabalExists -> getPhonyInstalledPackageInfo pkgname cabalFile - | otherwise -> return Nothing - -getFullInstalledPackageInfo :: PackageName -> FilePath - -> IO (Maybe InstalledPackageInfo) -getFullInstalledPackageInfo pkgname pkgconfFile = - withUTF8FileContents pkgconfFile $ \contents -> - case parseInstalledPackageInfo contents of - ParseOk _ pkginfo | packageName pkginfo == pkgname - -> return (Just pkginfo) - _ -> return Nothing - --- | This is a backup option for existing versions of nhc98 which do not supply --- proper installed package info files for the bundled libs. Instead we look --- for the .cabal file and extract the package version from that. --- We don't know any other details for such packages, in particular we pretend --- that they have no dependencies. --- -getPhonyInstalledPackageInfo :: PackageName -> FilePath - -> IO (Maybe InstalledPackageInfo) -getPhonyInstalledPackageInfo pkgname pathsModule = do - content <- readFile pathsModule - case extractVersion content of - Nothing -> return Nothing - Just version -> return (Just pkginfo) - where - pkgid = PackageIdentifier pkgname version - pkginfo = emptyInstalledPackageInfo { sourcePackageId = pkgid } - where - -- search through the .cabal file, looking for a line like: - -- - -- > version: 2.0 - -- - extractVersion :: String -> Maybe Version - extractVersion content = - case catMaybes (map extractVersionLine (lines content)) of - [version] -> Just version - _ -> Nothing - extractVersionLine :: String -> Maybe Version - extractVersionLine line = - case words line of - [versionTag, ":", versionStr] - | map toLower versionTag == "version" -> simpleParse versionStr - [versionTag, versionStr] - | map toLower versionTag == "version:" -> simpleParse versionStr - _ -> Nothing - --- Older installed package info files did not have the installedPackageId --- field, so if it is missing then we fill it as the source package ID. -setInstalledPackageId :: InstalledPackageInfo -> InstalledPackageInfo -setInstalledPackageId pkginfo@InstalledPackageInfo { - installedPackageId = InstalledPackageId "", - sourcePackageId = pkgid - } - = pkginfo { - --TODO use a proper named function for the conversion - -- from source package id to installed package id - installedPackageId = InstalledPackageId (display pkgid) - } -setInstalledPackageId pkginfo = pkginfo - --- ----------------------------------------------------------------------------- --- Building - --- |FIX: For now, the target must contain a main module. Not used --- ATM. Re-add later. -buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo - -> Library -> ComponentLocalBuildInfo -> IO () -buildLib verbosity pkg_descr lbi lib clbi = do - libName <- case componentLibraries clbi of - [libName] -> return libName - [] -> die "No library name found when building library" - _ -> die "Multiple library names found when building library" - let conf = withPrograms lbi - Just nhcProg = lookupProgram nhcProgram conf - let bi = libBuildInfo lib - modules = exposedModules lib ++ otherModules bi - -- Unsupported extensions have already been checked by configure - languageFlags = languageToFlags (compiler lbi) (defaultLanguage bi) - ++ extensionsToFlags (compiler lbi) (usedExtensions bi) - inFiles <- getModulePaths lbi bi modules - let targetDir = buildDir lbi - srcDirs = nub (map takeDirectory inFiles) - destDirs = map (targetDir ) srcDirs - mapM_ (createDirectoryIfMissingVerbose verbosity True) destDirs - rawSystemProgramConf verbosity hmakeProgram conf $ - ["-hc=" ++ programPath nhcProg] - ++ nhcVerbosityOptions verbosity - ++ ["-d", targetDir, "-hidir", targetDir] - ++ maybe [] (hcOptions NHC . libBuildInfo) - (library pkg_descr) - ++ languageFlags - ++ concat [ ["-package", display (packageName pkgid) ] - | (_, pkgid) <- componentPackageDeps clbi ] - ++ inFiles -{- - -- build any C sources - unless (null (cSources bi)) $ do - info verbosity "Building C Sources..." - let commonCcArgs = (if verbosity >= deafening then ["-v"] else []) - ++ ["-I" ++ dir | dir <- includeDirs bi] - ++ [opt | opt <- ccOptions bi] - ++ (if withOptimization lbi then ["-O2"] else []) - flip mapM_ (cSources bi) $ \cfile -> do - let ofile = targetDir cfile `replaceExtension` objExtension - createDirectoryIfMissingVerbose verbosity True (takeDirectory ofile) - rawSystemProgramConf verbosity hmakeProgram conf - (commonCcArgs ++ ["-c", cfile, "-o", ofile]) --} - -- link: - info verbosity "Linking..." - let --cObjs = [ targetDir cFile `replaceExtension` objExtension - -- | cFile <- cSources bi ] - libFilePath = targetDir mkLibName libName - hObjs = [ targetDir ModuleName.toFilePath m <.> objExtension - | m <- modules ] - - unless (null hObjs {-&& null cObjs-}) $ do - -- first remove library if it exists - removeFile libFilePath `catchIO` \_ -> return () - - let arVerbosity | verbosity >= deafening = "v" - | verbosity >= normal = "" - | otherwise = "c" - - rawSystemProgramConf verbosity arProgram (withPrograms lbi) $ - ["q"++ arVerbosity, libFilePath] - ++ hObjs --- ++ cObjs - --- | Building an executable for NHC. -buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo - -> Executable -> ComponentLocalBuildInfo -> IO () -buildExe verbosity pkg_descr lbi exe clbi = do - let conf = withPrograms lbi - Just nhcProg = lookupProgram nhcProgram conf - when (dropExtension (modulePath exe) /= exeName exe) $ - die $ "hmake does not support exe names that do not match the name of " - ++ "the 'main-is' file. You will have to rename your executable to " - ++ show (dropExtension (modulePath exe)) - let bi = buildInfo exe - modules = otherModules bi - -- Unsupported extensions have already been checked by configure - languageFlags = languageToFlags (compiler lbi) (defaultLanguage bi) - ++ extensionsToFlags (compiler lbi) (usedExtensions bi) - inFiles <- getModulePaths lbi bi modules - let targetDir = buildDir lbi exeName exe - exeDir = targetDir (exeName exe ++ "-tmp") - srcDirs = nub (map takeDirectory (modulePath exe : inFiles)) - destDirs = map (exeDir ) srcDirs - mapM_ (createDirectoryIfMissingVerbose verbosity True) destDirs - rawSystemProgramConf verbosity hmakeProgram conf $ - ["-hc=" ++ programPath nhcProg] - ++ nhcVerbosityOptions verbosity - ++ ["-d", targetDir, "-hidir", targetDir] - ++ maybe [] (hcOptions NHC . libBuildInfo) - (library pkg_descr) - ++ languageFlags - ++ concat [ ["-package", display (packageName pkgid) ] - | (_, pkgid) <- componentPackageDeps clbi ] - ++ inFiles - ++ [exeName exe] - -nhcVerbosityOptions :: Verbosity -> [String] -nhcVerbosityOptions verbosity - | verbosity >= deafening = ["-v"] - | verbosity >= normal = [] - | otherwise = ["-q"] - ---TODO: where to put this? it's duplicated in .Simple too -getModulePaths :: LocalBuildInfo -> BuildInfo -> [ModuleName] -> IO [FilePath] -getModulePaths lbi bi modules = sequence - [ findFileWithExtension ["hs", "lhs"] (buildDir lbi : hsSourceDirs bi) - (ModuleName.toFilePath module_) >>= maybe (notFound module_) (return . normalise) - | module_ <- modules ] - where notFound module_ = die $ "can't find source for module " ++ display module_ - --- ----------------------------------------------------------------------------- --- Installing - --- |Install executables for NHC. -installExe :: Verbosity -- ^verbosity - -> FilePath -- ^install location - -> FilePath -- ^Build location - -> (FilePath, FilePath) -- ^Executable (prefix,suffix) - -> Executable - -> IO () -installExe verbosity pref buildPref (progprefix,progsuffix) exe - = do createDirectoryIfMissingVerbose verbosity True pref - let exeBaseName = exeName exe - exeFileName = exeBaseName <.> exeExtension - fixedExeFileName = (progprefix ++ exeBaseName ++ progsuffix) <.> exeExtension - installExecutableFile verbosity - (buildPref exeBaseName exeFileName) - (pref fixedExeFileName) - --- |Install for nhc98: .hi and .a files -installLib :: Verbosity -- ^verbosity - -> FilePath -- ^install location - -> FilePath -- ^Build location - -> PackageIdentifier - -> Library - -> ComponentLocalBuildInfo - -> IO () -installLib verbosity pref buildPref _pkgid lib clbi - = do let bi = libBuildInfo lib - modules = exposedModules lib ++ otherModules bi - findModuleFiles [buildPref] ["hi"] modules - >>= installOrdinaryFiles verbosity pref - let libNames = map mkLibName (componentLibraries clbi) - installLib' libName = installOrdinaryFile verbosity - (buildPref libName) - (pref libName) - mapM_ installLib' libNames diff --git a/Distribution/Simple/PackageIndex.hs b/Distribution/Simple/PackageIndex.hs --- a/Distribution/Simple/PackageIndex.hs +++ b/Distribution/Simple/PackageIndex.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.PackageIndex @@ -12,7 +14,9 @@ -- module Distribution.Simple.PackageIndex ( -- * Package index data type + InstalledPackageIndex, PackageIndex, + FakeMap, -- * Creating an index fromList, @@ -32,6 +36,7 @@ -- ** Precise lookups lookupInstalledPackageId, lookupSourcePackageId, + lookupPackageId, lookupPackageName, lookupDependency, @@ -55,47 +60,92 @@ dependencyCycles, dependencyGraph, moduleNameIndex, + + -- ** Variants of special queries supporting fake map + fakeLookupInstalledPackageId, + brokenPackages', + dependencyClosure', + reverseDependencyClosure', + dependencyInconsistencies', + dependencyCycles', + dependencyGraph', ) where -import Prelude hiding (lookup) import Control.Exception (assert) -import qualified Data.Map as Map -import Data.Map (Map) -import qualified Data.Tree as Tree -import qualified Data.Graph as Graph -import qualified Data.Array as Array import Data.Array ((!)) +import qualified Data.Array as Array +import Data.Binary (Binary) +import qualified Data.Graph as Graph import Data.List as List ( null, foldl', sort , groupBy, sortBy, find, isInfixOf, nubBy, deleteBy, deleteFirstsBy ) import Data.Monoid (Monoid(..)) +import Data.Map (Map) +import qualified Data.Map as Map import Data.Maybe (isNothing, fromMaybe) +import qualified Data.Tree as Tree +import GHC.Generics (Generic) +import Prelude hiding (lookup) import Distribution.Package ( PackageName(..), PackageId , Package(..), packageName, packageVersion , Dependency(Dependency)--, --PackageFixedDeps(..) - , InstalledPackageId(..) ) + , InstalledPackageId(..), PackageInstalled(..) ) import Distribution.ModuleName ( ModuleName ) import Distribution.InstalledPackageInfo - ( InstalledPackageInfo, installedPackageId ) + ( InstalledPackageInfo ) import qualified Distribution.InstalledPackageInfo as IPI import Distribution.Version ( Version, withinRange ) import Distribution.Simple.Utils (lowercase, comparing, equating) +-- Note [FakeMap] +----------------- +-- We'd like to use the PackageIndex defined in this module for +-- cabal-install's InstallPlan. However, at the moment, this +-- data structure is indexed by InstalledPackageId, which we don't +-- know until after we've compiled a package (whereas InstallPlan +-- needs to store not-compiled packages in the index.) Eventually, +-- an InstalledPackageId will be calculatable prior to actually +-- building the package (making it something of a misnomer), but +-- at the moment, the "fake installed package ID map" is a workaround +-- to solve this problem while reusing PackageIndex. The basic idea +-- is that, since we don't know what an InstalledPackageId is +-- beforehand, we just fake up one based on the package ID (it only +-- needs to be unique for the particular install plan), and fill +-- it out with the actual generated InstalledPackageId after the +-- package is successfully compiled. +-- +-- However, there is a problem: in the index there may be +-- references using the old package ID, which are now dangling if +-- we update the InstalledPackageId. We could map over the entire +-- index to update these pointers as well (a costly operation), but +-- instead, we've chosen to parametrize a variety of important functions +-- by a FakeMap, which records what a fake installed package ID was +-- actually resolved to post-compilation. If we do a lookup, we first +-- check and see if it's a fake ID in the FakeMap. +-- +-- It's a bit grungy, but we expect this to only be temporary anyway. +-- (Another possible workaround would have been to *not* update +-- the installed package ID, but I decided this would be hard to +-- understand.) +-- | Map from fake installed package IDs to real ones. See Note [FakeMap] +type FakeMap = Map InstalledPackageId InstalledPackageId + -- | The collection of information about packages from one or more 'PackageDB's. +-- These packages generally should have an instance of 'PackageInstalled' -- -- Packages are uniquely identified in by their 'InstalledPackageId', they can -- also be efficiently looked up by package name or by name and version. -- -data PackageIndex = PackageIndex +data PackageIndex a = PackageIndex -- The primary index. Each InstalledPackageInfo record is uniquely identified -- by its InstalledPackageId. -- - !(Map InstalledPackageId InstalledPackageInfo) + !(Map InstalledPackageId a) -- This auxiliary index maps package names (case-sensitively) to all the -- versions and instances of that package. This allows us to find all @@ -108,18 +158,24 @@ -- -- FIXME: Clarify what "preference order" means. Check that this invariant is -- preserved. See #1463 for discussion. - !(Map PackageName (Map Version [InstalledPackageInfo])) + !(Map PackageName (Map Version [a])) - deriving (Show, Read) + deriving (Generic, Show, Read) -instance Monoid PackageIndex where +instance Binary a => Binary (PackageIndex a) + +-- | The default package index which contains 'InstalledPackageInfo'. Normally +-- use this. +type InstalledPackageIndex = PackageIndex InstalledPackageInfo + +instance PackageInstalled a => Monoid (PackageIndex a) where mempty = PackageIndex Map.empty Map.empty mappend = merge --save one mappend with empty in the common case: mconcat [] = mempty mconcat xs = foldr1 mappend xs -invariant :: PackageIndex -> Bool +invariant :: PackageInstalled a => PackageIndex a -> Bool invariant (PackageIndex pids pnames) = map installedPackageId (Map.elems pids) == sort @@ -140,9 +196,10 @@ -- * Internal helpers -- -mkPackageIndex :: Map InstalledPackageId InstalledPackageInfo - -> Map PackageName (Map Version [InstalledPackageInfo]) - -> PackageIndex +mkPackageIndex :: PackageInstalled a + => Map InstalledPackageId a + -> Map PackageName (Map Version [a]) + -> PackageIndex a mkPackageIndex pids pnames = assert (invariant index) index where index = PackageIndex pids pnames @@ -156,7 +213,7 @@ -- If there are duplicates by 'InstalledPackageId' then later ones mask earlier -- ones. -- -fromList :: [InstalledPackageInfo] -> PackageIndex +fromList :: PackageInstalled a => [a] -> PackageIndex a fromList pkgs = mkPackageIndex pids pnames where pids = Map.fromList [ (installedPackageId pkg, pkg) | pkg <- pkgs ] @@ -188,9 +245,9 @@ -- result when we do a lookup by source 'PackageId'. This is the mechanism we -- use to prefer user packages over global packages. -- -merge :: PackageIndex -> PackageIndex -> PackageIndex +merge :: PackageInstalled a => PackageIndex a -> PackageIndex a -> PackageIndex a merge (PackageIndex pids1 pnames1) (PackageIndex pids2 pnames2) = - mkPackageIndex (Map.union pids1 pids2) + mkPackageIndex (Map.unionWith (\_ y -> y) pids1 pids2) (Map.unionWith (Map.unionWith mergeBuckets) pnames1 pnames2) where -- Packages in the second list mask those in the first, however preferred @@ -204,7 +261,7 @@ -- This is equivalent to (but slightly quicker than) using 'mappend' or -- 'merge' with a singleton index. -- -insert :: InstalledPackageInfo -> PackageIndex -> PackageIndex +insert :: PackageInstalled a => a -> PackageIndex a -> PackageIndex a insert pkg (PackageIndex pids pnames) = mkPackageIndex pids' pnames' @@ -226,7 +283,7 @@ -- | Removes a single installed package from the index. -- -deleteInstalledPackageId :: InstalledPackageId -> PackageIndex -> PackageIndex +deleteInstalledPackageId :: PackageInstalled a => InstalledPackageId -> PackageIndex a -> PackageIndex a deleteInstalledPackageId ipkgid original@(PackageIndex pids pnames) = case Map.updateLookupWithKey (\_ _ -> Nothing) ipkgid pids of (Nothing, _) -> original @@ -248,7 +305,7 @@ -- | Removes all packages with this source 'PackageId' from the index. -- -deleteSourcePackageId :: PackageId -> PackageIndex -> PackageIndex +deleteSourcePackageId :: PackageInstalled a => PackageId -> PackageIndex a -> PackageIndex a deleteSourcePackageId pkgid original@(PackageIndex pids pnames) = case Map.lookup (packageName pkgid) pnames of Nothing -> original @@ -268,7 +325,7 @@ -- | Removes all packages with this (case-sensitive) name from the index. -- -deletePackageName :: PackageName -> PackageIndex -> PackageIndex +deletePackageName :: PackageInstalled a => PackageName -> PackageIndex a -> PackageIndex a deletePackageName name original@(PackageIndex pids pnames) = case Map.lookup name pnames of Nothing -> original @@ -291,14 +348,14 @@ -- | Get all the packages from the index. -- -allPackages :: PackageIndex -> [InstalledPackageInfo] +allPackages :: PackageIndex a -> [a] allPackages (PackageIndex pids _) = Map.elems pids -- | Get all the packages from the index. -- -- They are grouped by package name (case-sensitively). -- -allPackagesByName :: PackageIndex -> [(PackageName, [InstalledPackageInfo])] +allPackagesByName :: PackageIndex a -> [(PackageName, [a])] allPackagesByName (PackageIndex _ pnames) = [ (pkgname, concat (Map.elems pvers)) | (pkgname, pvers) <- Map.toList pnames ] @@ -307,7 +364,7 @@ -- -- They are grouped by source package id (package name and version). -- -allPackagesBySourcePackageId :: PackageIndex -> [(PackageId, [InstalledPackageInfo])] +allPackagesBySourcePackageId :: PackageInstalled a => PackageIndex a -> [(PackageId, [a])] allPackagesBySourcePackageId (PackageIndex _ pnames) = [ (packageId ipkg, ipkgs) | pvers <- Map.elems pnames @@ -322,8 +379,8 @@ -- Since multiple package DBs mask each other by 'InstalledPackageId', -- then we get back at most one package. -- -lookupInstalledPackageId :: PackageIndex -> InstalledPackageId - -> Maybe InstalledPackageInfo +lookupInstalledPackageId :: PackageInstalled a => PackageIndex a -> InstalledPackageId + -> Maybe a lookupInstalledPackageId (PackageIndex pids _) pid = Map.lookup pid pids @@ -333,7 +390,7 @@ -- but different 'InstalledPackageId'. They are returned in order of -- preference, with the most preferred first. -- -lookupSourcePackageId :: PackageIndex -> PackageId -> [InstalledPackageInfo] +lookupSourcePackageId :: PackageInstalled a => PackageIndex a -> PackageId -> [a] lookupSourcePackageId (PackageIndex _ pnames) pkgid = case Map.lookup (packageName pkgid) pnames of Nothing -> [] @@ -341,11 +398,18 @@ Nothing -> [] Just pkgs -> pkgs -- in preference order +-- | Convenient alias of 'lookupSourcePackageId', but assuming only +-- one package per package ID. +lookupPackageId :: PackageInstalled a => PackageIndex a -> PackageId -> Maybe a +lookupPackageId index pkgid = case lookupSourcePackageId index pkgid of + [] -> Nothing + [pkg] -> Just pkg + _ -> error "Distribution.Simple.PackageIndex: multiple matches found" -- | Does a lookup by source package name. -- -lookupPackageName :: PackageIndex -> PackageName - -> [(Version, [InstalledPackageInfo])] +lookupPackageName :: PackageInstalled a => PackageIndex a -> PackageName + -> [(Version, [a])] lookupPackageName (PackageIndex _ pnames) name = case Map.lookup name pnames of Nothing -> [] @@ -357,8 +421,8 @@ -- We get back any number of versions of the specified package name, all -- satisfying the version range constraint. -- -lookupDependency :: PackageIndex -> Dependency - -> [(Version, [InstalledPackageInfo])] +lookupDependency :: PackageInstalled a => PackageIndex a -> Dependency + -> [(Version, [a])] lookupDependency (PackageIndex _ pnames) (Dependency name versionRange) = case Map.lookup name pnames of Nothing -> [] @@ -382,7 +446,7 @@ -- packages. The list of ambiguous results is split by exact package name. So -- it is a non-empty list of non-empty lists. -- -searchByName :: PackageIndex -> String -> SearchResult [InstalledPackageInfo] +searchByName :: PackageInstalled a => PackageIndex a -> String -> SearchResult [a] searchByName (PackageIndex _ pnames) name = case [ pkgs | pkgs@(PackageName name',_) <- Map.toList pnames , lowercase name' == lname ] of @@ -399,7 +463,7 @@ -- -- That is, all packages that contain the given string in their name. -- -searchByNameSubstring :: PackageIndex -> String -> [InstalledPackageInfo] +searchByNameSubstring :: PackageInstalled a => PackageIndex a -> String -> [a] searchByNameSubstring (PackageIndex _ pnames) searchterm = [ pkg | (PackageName name, pvers) <- Map.toList pnames @@ -423,11 +487,15 @@ -- list of groups of packages where within each group they all depend on each -- other, directly or indirectly. -- -dependencyCycles :: PackageIndex -> [[InstalledPackageInfo]] -dependencyCycles index = +dependencyCycles :: PackageInstalled a => PackageIndex a -> [[a]] +dependencyCycles = dependencyCycles' Map.empty + +-- | Variant of 'dependencyCycles' which accepts a 'FakeMap'. See Note [FakeMap]. +dependencyCycles' :: PackageInstalled a => FakeMap -> PackageIndex a -> [[a]] +dependencyCycles' fakeMap index = [ vs | Graph.CyclicSCC vs <- Graph.stronglyConnComp adjacencyList ] where - adjacencyList = [ (pkg, installedPackageId pkg, IPI.depends pkg) + adjacencyList = [ (pkg, installedPackageId pkg, fakeInstalledDepends fakeMap pkg) | pkg <- allPackages index ] @@ -435,14 +503,21 @@ -- -- Returns such packages along with the dependencies that they're missing. -- -brokenPackages :: PackageIndex -> [(InstalledPackageInfo, [InstalledPackageId])] -brokenPackages index = +brokenPackages :: PackageInstalled a => PackageIndex a -> [(a, [InstalledPackageId])] +brokenPackages = brokenPackages' Map.empty + +-- | Variant of 'brokenPackages' which accepts a 'FakeMap'. See Note [FakeMap]. +brokenPackages' :: PackageInstalled a => FakeMap -> PackageIndex a -> [(a, [InstalledPackageId])] +brokenPackages' fakeMap index = [ (pkg, missing) | pkg <- allPackages index - , let missing = [ pkg' | pkg' <- IPI.depends pkg - , isNothing (lookupInstalledPackageId index pkg') ] + , let missing = [ pkg' | pkg' <- installedDepends pkg + , isNothing (fakeLookupInstalledPackageId fakeMap index pkg') ] , not (null missing) ] +-- | Variant of 'lookupInstalledPackageId' which accepts a 'FakeMap'. See Note [FakeMap]. +fakeLookupInstalledPackageId :: PackageInstalled a => FakeMap -> PackageIndex a -> InstalledPackageId -> Maybe a +fakeLookupInstalledPackageId fakeMap index pkg = lookupInstalledPackageId index (Map.findWithDefault pkg pkg fakeMap) -- | Tries to take the transitive closure of the package dependencies. -- @@ -452,48 +527,63 @@ -- * Note that if the result is @Right []@ it is because at least one of -- the original given 'PackageId's do not occur in the index. -- -dependencyClosure :: PackageIndex +dependencyClosure :: PackageInstalled a => PackageIndex a -> [InstalledPackageId] - -> Either PackageIndex - [(InstalledPackageInfo, [InstalledPackageId])] -dependencyClosure index pkgids0 = case closure mempty [] pkgids0 of + -> Either (PackageIndex a) + [(a, [InstalledPackageId])] +dependencyClosure = dependencyClosure' Map.empty + +-- | Variant of 'dependencyClosure' which accepts a 'FakeMap'. See Note [FakeMap]. +dependencyClosure' :: PackageInstalled a => FakeMap + -> PackageIndex a + -> [InstalledPackageId] + -> Either (PackageIndex a) + [(a, [InstalledPackageId])] +dependencyClosure' fakeMap index pkgids0 = case closure mempty [] pkgids0 of (completed, []) -> Left completed (completed, _) -> Right (brokenPackages completed) where closure completed failed [] = (completed, failed) - closure completed failed (pkgid:pkgids) = case lookupInstalledPackageId index pkgid of + closure completed failed (pkgid:pkgids) = case fakeLookupInstalledPackageId fakeMap index pkgid of Nothing -> closure completed (pkgid:failed) pkgids - Just pkg -> case lookupInstalledPackageId completed (installedPackageId pkg) of + Just pkg -> case fakeLookupInstalledPackageId fakeMap completed (installedPackageId pkg) of Just _ -> closure completed failed pkgids Nothing -> closure completed' failed pkgids' where completed' = insert pkg completed - pkgids' = IPI.depends pkg ++ pkgids + pkgids' = installedDepends pkg ++ pkgids -- | Takes the transitive closure of the packages reverse dependencies. -- -- * The given 'PackageId's must be in the index. -- -reverseDependencyClosure :: PackageIndex +reverseDependencyClosure :: PackageInstalled a => PackageIndex a -> [InstalledPackageId] - -> [InstalledPackageInfo] -reverseDependencyClosure index = + -> [a] +reverseDependencyClosure = reverseDependencyClosure' Map.empty + +-- | Variant of 'reverseDependencyClosure' which accepts a 'FakeMap'. See Note [FakeMap]. +reverseDependencyClosure' :: PackageInstalled a => FakeMap + -> PackageIndex a + -> [InstalledPackageId] + -> [a] +reverseDependencyClosure' fakeMap index = map vertexToPkg . concatMap Tree.flatten . Graph.dfs reverseDepGraph . map (fromMaybe noSuchPkgId . pkgIdToVertex) where - (depGraph, vertexToPkg, pkgIdToVertex) = dependencyGraph index + (depGraph, vertexToPkg, pkgIdToVertex) = dependencyGraph' fakeMap index reverseDepGraph = Graph.transposeG depGraph noSuchPkgId = error "reverseDependencyClosure: package is not in the graph" -topologicalOrder :: PackageIndex -> [InstalledPackageInfo] +topologicalOrder :: PackageInstalled a => PackageIndex a -> [a] topologicalOrder index = map toPkgId . Graph.topSort $ graph where (graph, toPkgId, _) = dependencyGraph index -reverseTopologicalOrder :: PackageIndex -> [InstalledPackageInfo] +reverseTopologicalOrder :: PackageInstalled a => PackageIndex a -> [a] reverseTopologicalOrder index = map toPkgId . Graph.topSort . Graph.transposeG @@ -505,20 +595,28 @@ -- Dependencies on other packages that are not in the index are discarded. -- You can check if there are any such dependencies with 'brokenPackages'. -- -dependencyGraph :: PackageIndex +dependencyGraph :: PackageInstalled a => PackageIndex a -> (Graph.Graph, - Graph.Vertex -> InstalledPackageInfo, + Graph.Vertex -> a, InstalledPackageId -> Maybe Graph.Vertex) -dependencyGraph index = (graph, vertex_to_pkg, id_to_vertex) +dependencyGraph = dependencyGraph' Map.empty + +-- | Variant of 'dependencyGraph' which accepts a 'FakeMap'. See Note [FakeMap]. +dependencyGraph' :: PackageInstalled a => FakeMap + -> PackageIndex a + -> (Graph.Graph, + Graph.Vertex -> a, + InstalledPackageId -> Maybe Graph.Vertex) +dependencyGraph' fakeMap index = (graph, vertex_to_pkg, id_to_vertex) where graph = Array.listArray bounds - [ [ v | Just v <- map id_to_vertex (IPI.depends pkg) ] + [ [ v | Just v <- map id_to_vertex (installedDepends pkg) ] | pkg <- pkgs ] pkgs = sortBy (comparing packageId) (allPackages index) vertices = zip (map installedPackageId pkgs) [0..] vertex_map = Map.fromList vertices - id_to_vertex pid = Map.lookup pid vertex_map + id_to_vertex pid = Map.lookup (Map.findWithDefault pid pid fakeMap) vertex_map vertex_to_pkg vertex = pkgTable ! vertex @@ -536,9 +634,14 @@ -- depend on it and the versions they require. These are guaranteed to be -- distinct. -- -dependencyInconsistencies :: PackageIndex +dependencyInconsistencies :: PackageInstalled a => PackageIndex a -> [(PackageName, [(PackageId, Version)])] -dependencyInconsistencies index = +dependencyInconsistencies = dependencyInconsistencies' Map.empty + +-- | Variant of 'dependencyInconsistencies' which accepts a 'FakeMap'. See Note [FakeMap]. +dependencyInconsistencies' :: PackageInstalled a => FakeMap -> PackageIndex a + -> [(PackageName, [(PackageId, Version)])] +dependencyInconsistencies' fakeMap index = [ (name, [ (pid,packageVersion dep) | (dep,pids) <- uses, pid <- pids]) | (name, ipid_map) <- Map.toList inverseIndex , let uses = Map.elems ipid_map @@ -548,29 +651,42 @@ -- for each package with that name, -- the InstalledPackageInfo and the package Ids of packages -- that depend on it. - inverseIndex :: Map PackageName - (Map InstalledPackageId - (InstalledPackageInfo, [PackageId])) inverseIndex = Map.fromListWith (Map.unionWith (\(a,b) (_,b') -> (a,b++b'))) [ (packageName dep, Map.fromList [(ipid,(dep,[packageId pkg]))]) | pkg <- allPackages index - , ipid <- IPI.depends pkg - , Just dep <- [lookupInstalledPackageId index ipid] + , ipid <- fakeInstalledDepends fakeMap pkg + , Just dep <- [fakeLookupInstalledPackageId fakeMap index ipid] ] - reallyIsInconsistent :: [InstalledPackageInfo] -> Bool + reallyIsInconsistent :: PackageInstalled a => [a] -> Bool reallyIsInconsistent [] = False reallyIsInconsistent [_p] = False reallyIsInconsistent [p1, p2] = - installedPackageId p1 `notElem` IPI.depends p2 - && installedPackageId p2 `notElem` IPI.depends p1 + let pid1 = installedPackageId p1 + pid2 = installedPackageId p2 + in Map.findWithDefault pid1 pid1 fakeMap `notElem` fakeInstalledDepends fakeMap p2 + && Map.findWithDefault pid2 pid2 fakeMap `notElem` fakeInstalledDepends fakeMap p1 reallyIsInconsistent _ = True +-- | Variant of 'installedDepends' which accepts a 'FakeMap'. See Note [FakeMap]. +fakeInstalledDepends :: PackageInstalled a => FakeMap -> a -> [InstalledPackageId] +fakeInstalledDepends fakeMap = map (\pid -> Map.findWithDefault pid pid fakeMap) . installedDepends -moduleNameIndex :: PackageIndex -> Map ModuleName [InstalledPackageInfo] +-- | A rough approximation of GHC's module finder, takes a 'InstalledPackageIndex' and +-- turns it into a map from module names to their source packages. It's used to +-- initialize the @build-deps@ field in @cabal init@. +moduleNameIndex :: InstalledPackageIndex -> Map ModuleName [InstalledPackageInfo] moduleNameIndex index = - Map.fromListWith (++) - [ (moduleName, [pkg]) - | pkg <- allPackages index - , moduleName <- IPI.exposedModules pkg ] + Map.fromListWith (++) $ do + pkg <- allPackages index + IPI.ExposedModule m reexport _ <- IPI.exposedModules pkg + case reexport of + Nothing -> return (m, [pkg]) + Just (IPI.OriginalModule _ m') | m == m' -> [] + | otherwise -> return (m', [pkg]) + -- The heuristic is this: we want to prefer the original package + -- which originally exported a module. However, if a reexport + -- also *renamed* the module (m /= m'), then we have to use the + -- downstream package, since the upstream package has the wrong + -- module name! diff --git a/Distribution/Simple/PreProcess.hs b/Distribution/Simple/PreProcess.hs --- a/Distribution/Simple/PreProcess.hs +++ b/Distribution/Simple/PreProcess.hs @@ -44,7 +44,8 @@ import Distribution.Simple.CCompiler ( cSourceExtensions ) import Distribution.Simple.Compiler - ( CompilerFlavor(..), compilerFlavor, compilerVersion ) + ( CompilerFlavor(..) + , compilerFlavor, compilerCompatVersion, compilerVersion ) import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), Component(..) ) import Distribution.Simple.BuildPaths (autogenModulesDir,cppHeaderName) @@ -57,7 +58,7 @@ , requireProgram, requireProgramVersion , rawSystemProgramConf, rawSystemProgram , greencardProgram, cpphsProgram, hsc2hsProgram, c2hsProgram - , happyProgram, alexProgram, ghcProgram, gccProgram ) + , happyProgram, alexProgram, ghcProgram, ghcjsProgram, gccProgram ) import Distribution.Simple.Test.LibV09 ( writeSimpleTestStub, stubFilePath, stubName ) import Distribution.System @@ -97,12 +98,12 @@ -- -- The reason for splitting it up this way is that some pre-processors don't -- simply generate one output .hs file from one input file but have --- dependencies on other genereated files (notably c2hs, where building one +-- dependencies on other generated files (notably c2hs, where building one -- .hs file may require reading other .chi files, and then compiling the .hs -- file may require reading a generated .h file). In these cases the generated -- files need to embed relative path names to each other (eg the generated .hs -- file mentions the .h file in the FFI imports). This path must be relative to --- the base directory where the genereated files are located, it cannot be +-- the base directory where the generated files are located, it cannot be -- relative to the top level of the build tree because the compilers do not -- look for .h files relative to there, ie we do not use \"-I .\", instead we -- use \"-I dist\/build\" (or whatever dist dir has been set by the user) @@ -192,11 +193,9 @@ BenchmarkUnsupported tt -> die $ "No support for preprocessing benchmark " ++ "type " ++ display tt where - builtinHaskellSuffixes - | NHC == compilerFlavor (compiler lbi) = ["hs", "lhs", "gc"] - | otherwise = ["hs", "lhs"] - builtinCSuffixes = cSourceExtensions - builtinSuffixes = builtinHaskellSuffixes ++ builtinCSuffixes + builtinHaskellSuffixes = ["hs", "lhs", "hsig", "lhsig"] + builtinCSuffixes = cSourceExtensions + builtinSuffixes = builtinHaskellSuffixes ++ builtinCSuffixes localHandlers bi = [(ext, h bi lbi) | (ext, h) <- handlers] pre dirs dir lhndlrs fp = preprocessFile dirs dir isSrcDist fp verbosity builtinSuffixes lhndlrs @@ -335,26 +334,28 @@ ppCpp' :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor ppCpp' extraArgs bi lbi = case compilerFlavor (compiler lbi) of - GHC -> ppGhcCpp (cppArgs ++ extraArgs) bi lbi - _ -> ppCpphs (cppArgs ++ extraArgs) bi lbi - + GHC -> ppGhcCpp ghcProgram (>= Version [6,6] []) args bi lbi + GHCJS -> ppGhcCpp ghcjsProgram (const True) args bi lbi + _ -> ppCpphs args bi lbi where cppArgs = getCppOptions bi lbi + args = cppArgs ++ extraArgs -ppGhcCpp :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor -ppGhcCpp extraArgs _bi lbi = +ppGhcCpp :: Program -> (Version -> Bool) + -> [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor +ppGhcCpp program xHs extraArgs _bi lbi = PreProcessor { platformIndependent = False, runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> do - (ghcProg, ghcVersion, _) <- requireProgramVersion verbosity - ghcProgram anyVersion (withPrograms lbi) - rawSystemProgram verbosity ghcProg $ + (prog, version, _) <- requireProgramVersion verbosity + program anyVersion (withPrograms lbi) + rawSystemProgram verbosity prog $ ["-E", "-cpp"] -- This is a bit of an ugly hack. We're going to -- unlit the file ourselves later on if appropriate, -- so we need GHC not to unlit it now or it'll get -- double-unlitted. In the future we might switch to -- using cpphs --unlit instead. - ++ (if ghcVersion >= Version [6,6] [] then ["-x", "hs"] else []) + ++ (if xHs version then ["-x", "hs"] else []) ++ [ "-optP-include", "-optP"++ (autogenModulesDir lbi cppHeaderName) ] ++ ["-o", outFile, inFile] ++ extraArgs @@ -441,8 +442,9 @@ isOSX = case buildOS of OSX -> True; _ -> False isELF = case buildOS of OSX -> False; Windows -> False; _ -> True; packageHacks = case compilerFlavor (compiler lbi) of - GHC -> hackRtsPackage - _ -> id + GHC -> hackRtsPackage + GHCJS -> hackRtsPackage + _ -> id -- We don't link in the actual Haskell libraries of our dependencies, so -- the -u flags in the ldOptions of the rts package mean linking fails on -- OS X (it's ld is a tad stricter than gnu ld). Thus we remove the @@ -506,9 +508,14 @@ ["-D" ++ arch ++ "_BUILD_ARCH=1"] ++ map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") osStr ++ map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr + GHCJS -> + compatGlasgowHaskell ++ + ["-D__GHCJS__=" ++ versionInt version] ++ + ["-D" ++ os ++ "_BUILD_OS=1"] ++ + ["-D" ++ arch ++ "_BUILD_ARCH=1"] ++ + map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") osStr ++ + map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr JHC -> ["-D__JHC__=" ++ versionInt version] - NHC -> ["-D__NHC__=" ++ versionInt version] - Hugs -> ["-D__HUGS__"] HaskellSuite {} -> ["-D__HASKELL_SUITE__"] ++ map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") osStr ++ @@ -518,6 +525,9 @@ comp = compiler lbi Platform hostArch hostOS = hostPlatform lbi version = compilerVersion comp + compatGlasgowHaskell = + maybe [] (\v -> ["-D__GLASGOW_HASKELL__=" ++ versionInt v]) + (compilerCompatVersion GHC comp) -- TODO: move this into the compiler abstraction -- FIXME: this forces GHC's crazy 4.8.2 -> 408 convention on all -- the other compilers. Check if that's really what they want. @@ -547,6 +557,7 @@ IRIX -> ["irix"] HaLVM -> [] IOS -> ["ios"] + Ghcjs -> ["ghcjs"] OtherOS _ -> [] archStr = case hostArch of I386 -> ["i386"] @@ -564,6 +575,7 @@ Rs6000 -> ["rs6000"] M68k -> ["m68k"] Vax -> ["vax"] + JavaScript -> ["javascript"] OtherArch _ -> [] ppHappy :: BuildInfo -> LocalBuildInfo -> PreProcessor @@ -571,6 +583,7 @@ where pp = standardPP lbi happyProgram (hcFlags hc) hc = compilerFlavor (compiler lbi) hcFlags GHC = ["-agc"] + hcFlags GHCJS = ["-agc"] hcFlags _ = [] ppAlex :: BuildInfo -> LocalBuildInfo -> PreProcessor @@ -578,6 +591,7 @@ where pp = standardPP lbi alexProgram (hcFlags hc) hc = compilerFlavor (compiler lbi) hcFlags GHC = ["-g"] + hcFlags GHCJS = ["-g"] hcFlags _ = [] standardPP :: LocalBuildInfo -> Program -> [String] -> PreProcessor diff --git a/Distribution/Simple/Program.hs b/Distribution/Simple/Program.hs --- a/Distribution/Simple/Program.hs +++ b/Distribution/Simple/Program.hs @@ -79,6 +79,7 @@ , userSpecifyArgss , userSpecifiedArgs , lookupProgram + , lookupProgramVersion , updateProgram , configureProgram , configureAllKnownPrograms @@ -91,13 +92,12 @@ -- * Programs that Cabal knows about , ghcProgram , ghcPkgProgram + , ghcjsProgram + , ghcjsPkgProgram , lhcProgram , lhcPkgProgram - , nhcProgram , hmakeProgram , jhcProgram - , hugsProgram - , ffihugsProgram , uhcProgram , gccProgram , arProgram diff --git a/Distribution/Simple/Program/Ar.hs b/Distribution/Simple/Program/Ar.hs --- a/Distribution/Simple/Program/Ar.hs +++ b/Distribution/Simple/Program/Ar.hs @@ -124,6 +124,7 @@ , "0 " -- GID, 6 bytes , "0644 " -- mode, 8 bytes ] + headerSize :: Int headerSize = 60 -- http://en.wikipedia.org/wiki/Ar_(Unix)#File_format_details diff --git a/Distribution/Simple/Program/Builtin.hs b/Distribution/Simple/Program/Builtin.hs --- a/Distribution/Simple/Program/Builtin.hs +++ b/Distribution/Simple/Program/Builtin.hs @@ -18,13 +18,12 @@ -- * Programs that Cabal knows about ghcProgram, ghcPkgProgram, + ghcjsProgram, + ghcjsPkgProgram, lhcProgram, lhcPkgProgram, - nhcProgram, hmakeProgram, jhcProgram, - hugsProgram, - ffihugsProgram, haskellSuiteProgram, haskellSuitePkgProgram, uhcProgram, @@ -46,13 +45,26 @@ hpcProgram, ) where -import Distribution.Simple.Program.Types - ( Program(..), simpleProgram ) import Distribution.Simple.Program.Find ( findProgramOnSearchPath ) +import Distribution.Simple.Program.Run + ( getProgramInvocationOutput, programInvocation ) +import Distribution.Simple.Program.Types + ( Program(..), ConfiguredProgram(..), simpleProgram ) import Distribution.Simple.Utils ( findProgramVersion ) +import Distribution.Compat.Exception + ( catchIO ) +import Distribution.Version + ( Version(..), withinRange, earlierVersion, laterVersion + , intersectVersionRanges ) +import Data.Char + ( isDigit ) +import Data.List + ( isInfixOf ) +import qualified Data.Map as Map + -- ------------------------------------------------------------ -- * Known programs -- ------------------------------------------------------------ @@ -65,11 +77,10 @@ -- compilers and related progs ghcProgram , ghcPkgProgram - , hugsProgram - , ffihugsProgram + , ghcjsProgram + , ghcjsPkgProgram , haskellSuiteProgram , haskellSuitePkgProgram - , nhcProgram , hmakeProgram , jhcProgram , lhcProgram @@ -97,7 +108,23 @@ ghcProgram :: Program ghcProgram = (simpleProgram "ghc") { - programFindVersion = findProgramVersion "--numeric-version" id + programFindVersion = findProgramVersion "--numeric-version" id, + + -- Workaround for https://ghc.haskell.org/trac/ghc/ticket/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 $ Version [7,8,0] []) + (earlierVersion $ Version [7,8,4] []) + return $ maybe ghcProg + (\v -> if withinRange v affectedVersionRange + then ghcProg' else ghcProg) + (programVersion ghcProg) } ghcPkgProgram :: Program @@ -110,6 +137,21 @@ _ -> "" } +ghcjsProgram :: Program +ghcjsProgram = (simpleProgram "ghcjs") { + programFindVersion = findProgramVersion "--numeric-ghcjs-version" id + } + +ghcjsPkgProgram :: Program +ghcjsPkgProgram = (simpleProgram "ghcjs-pkg") { + programFindVersion = findProgramVersion "--ghcjs-version" $ \str -> + -- Invoking "ghcjs-pkg --version" gives a string like + -- "GHCJS package manager version 6.4.1" + case words str of + (_:_:_:_:ver:_) -> ver + _ -> "" + } + lhcProgram :: Program lhcProgram = (simpleProgram "lhc") { programFindVersion = findProgramVersion "--numeric-version" id @@ -125,16 +167,6 @@ _ -> "" } -nhcProgram :: Program -nhcProgram = (simpleProgram "nhc98") { - programFindVersion = findProgramVersion "--version" $ \str -> - -- Invoking "nhc98 --version" gives a string like - -- "/usr/local/bin/nhc98: v1.20 (2007-11-22)" - case words str of - (_:('v':ver):_) -> ver - _ -> "" - } - hmakeProgram :: Program hmakeProgram = (simpleProgram "hmake") { programFindVersion = findProgramVersion "--version" $ \str -> @@ -170,13 +202,6 @@ _ -> "" } --- AArgh! Finding the version of hugs or ffihugs is almost impossible. -hugsProgram :: Program -hugsProgram = simpleProgram "hugs" - -ffihugsProgram :: Program -ffihugsProgram = simpleProgram "ffihugs" - -- 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, @@ -226,7 +251,7 @@ -- Invoking "alex --version" gives a string like -- "Alex version 2.1.0, (c) 2003 Chris Dornan and Simon Marlow" case words str of - (_:_:ver:_) -> takeWhile (`elem` ('.':['0'..'9'])) ver + (_:_:ver:_) -> takeWhile (\x -> isDigit x || x == '.') ver _ -> "" } @@ -292,7 +317,19 @@ ldProgram = simpleProgram "ld" tarProgram :: Program -tarProgram = simpleProgram "tar" +tarProgram = (simpleProgram "tar") { + -- See #1901. Some versions of 'tar' (OpenBSD, NetBSD, ...) don't support the + -- '--format' option. + programPostConf = \verbosity tarProg -> do + tarHelpOutput <- getProgramInvocationOutput + verbosity (programInvocation tarProg ["--help"]) + -- Some versions of tar don't support '--help'. + `catchIO` (\_ -> return "") + let k = "Supports --format" + v = if ("--format" `isInfixOf` tarHelpOutput) then "YES" else "NO" + m = Map.insert k v (programProperties tarProg) + return $ tarProg { programProperties = m } + } cppProgram :: Program cppProgram = simpleProgram "cpp" diff --git a/Distribution/Simple/Program/Db.hs b/Distribution/Simple/Program/Db.hs --- a/Distribution/Simple/Program/Db.hs +++ b/Distribution/Simple/Program/Db.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.Program.Db @@ -34,6 +36,7 @@ knownPrograms, getProgramSearchPath, setProgramSearchPath, + modifyProgramSearchPath, userSpecifyPath, userSpecifyPaths, userMaybeSpecifyPath, @@ -47,6 +50,7 @@ -- ** Query and manipulate the program db configureProgram, configureAllKnownPrograms, + lookupProgramVersion, reconfigurePrograms, requireProgram, requireProgramVersion, @@ -69,6 +73,8 @@ import Distribution.Verbosity ( Verbosity ) +import Data.Binary (Binary(..)) +import Data.Functor ((<$>)) import Data.List ( foldl' ) import Data.Maybe @@ -131,7 +137,13 @@ [ (emptyProgramDb { configuredProgs = Map.fromList s' }, r) | (s', r) <- readsPrec p s ] +instance Binary ProgramDb where + put = put . configuredProgs + get = do + progs <- get + return $! emptyProgramDb { configuredProgs = progs } + -- | The Read\/Show instance does not preserve all the unconfigured 'Programs' -- because 'Program' is not in Read\/Show because it contains functions. So to -- fully restore a deserialised 'ProgramDb' use this function to add @@ -185,6 +197,16 @@ setProgramSearchPath :: ProgramSearchPath -> ProgramDb -> ProgramDb setProgramSearchPath searchpath db = db { progSearchPath = searchpath } +-- | Modify the current 'ProgramSearchPath' used by the 'ProgramDb'. +-- This will affect programs that are configured from here on, so you +-- should usually modify it before configuring any programs. +-- +modifyProgramSearchPath :: (ProgramSearchPath -> ProgramSearchPath) + -> ProgramDb + -> ProgramDb +modifyProgramSearchPath f db = + setProgramSearchPath (f $ getProgramSearchPath db) db + -- |User-specify this path. Basically override any path information -- for this program in the configuration. If it's not a known -- program ignore it. @@ -284,7 +306,7 @@ -- -- The reason for it not being a failure at this stage is that we don't know up -- front all the programs we will need, so we try to configure them all. --- To verify that a program was actually sucessfully configured use +-- To verify that a program was actually successfully configured use -- 'requireProgram'. -- configureProgram :: Verbosity @@ -317,6 +339,7 @@ programDefaultArgs = [], programOverrideArgs = userSpecifiedArgs prog conf, programOverrideEnv = [("PATH", Just newPath)], + programProperties = Map.empty, programLocation = location } configuredProg' <- programPostConf prog verbosity configuredProg @@ -389,32 +412,35 @@ -- | Check that a program is configured and available to be run. -- --- Additionally check that the version of the program number is suitable and --- return it. For example you could require 'AnyVersion' or --- @'orLaterVersion' ('Version' [1,0] [])@ +-- Additionally check that the program version number is suitable and return +-- it. For example you could require 'AnyVersion' or @'orLaterVersion' +-- ('Version' [1,0] [])@ -- --- It raises an exception if the program could not be configured or the version --- is unsuitable, otherwise it returns the configured program and its version --- number. +-- It returns the configured program, its version number and a possibly updated +-- 'ProgramDb'. If the program could not be configured or the version is +-- unsuitable, it returns an error value. -- -requireProgramVersion :: Verbosity -> Program -> VersionRange - -> ProgramDb - -> IO (ConfiguredProgram, Version, ProgramDb) -requireProgramVersion verbosity prog range conf = do +lookupProgramVersion + :: Verbosity -> Program -> VersionRange -> ProgramDb + -> IO (Either String (ConfiguredProgram, Version, ProgramDb)) +lookupProgramVersion verbosity prog range programDb = do -- If it's not already been configured, try to configure it now - conf' <- case lookupProgram prog conf of - Nothing -> configureProgram verbosity prog conf - Just _ -> return conf + programDb' <- case lookupProgram prog programDb of + Nothing -> configureProgram verbosity prog programDb + Just _ -> return programDb - case lookupProgram prog conf' of - Nothing -> die notFound + case lookupProgram prog programDb' of + Nothing -> return $! Left notFound Just configuredProg@ConfiguredProgram { programLocation = location } -> case programVersion configuredProg of Just version - | withinRange version range -> return (configuredProg, version, conf') - | otherwise -> die (badVersion version location) - Nothing -> die (noVersion location) + | withinRange version range -> + return $! Right (configuredProg, version ,programDb') + | otherwise -> + return $! Left (badVersion version location) + Nothing -> + return $! Left (noVersion location) where notFound = "The program '" ++ programName prog ++ "'" ++ versionRequirement @@ -430,3 +456,13 @@ versionRequirement | isAnyVersion range = "" | otherwise = " version " ++ display range + +-- | Like 'lookupProgramVersion', but raises an exception in case of error +-- instead of returning 'Left errMsg'. +-- +requireProgramVersion :: Verbosity -> Program -> VersionRange + -> ProgramDb + -> IO (ConfiguredProgram, Version, ProgramDb) +requireProgramVersion verbosity prog range programDb = + join $ either die return <$> + lookupProgramVersion verbosity prog range programDb diff --git a/Distribution/Simple/Program/Find.hs b/Distribution/Simple/Program/Find.hs --- a/Distribution/Simple/Program/Find.hs +++ b/Distribution/Simple/Program/Find.hs @@ -89,6 +89,7 @@ -- .bat; .cmd". extensions = case buildOS of Windows -> ["", "exe"] + Ghcjs -> ["", "exe"] _ -> [""] tryPathElem ProgramSearchPathDefault = do diff --git a/Distribution/Simple/Program/GHC.hs b/Distribution/Simple/Program/GHC.hs --- a/Distribution/Simple/Program/GHC.hs +++ b/Distribution/Simple/Program/GHC.hs @@ -11,20 +11,23 @@ ) where +import Distribution.Simple.GHC.ImplInfo ( getImplInfo, GhcImplInfo(..) ) import Distribution.Package +import Distribution.PackageDescription hiding (Flag) import Distribution.ModuleName import Distribution.Simple.Compiler hiding (Flag) import Distribution.Simple.Setup ( Flag(..), flagToMaybe, fromFlagOrDefault, flagToList ) ---import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program.Types import Distribution.Simple.Program.Run import Distribution.Text import Distribution.Verbosity -import Distribution.Version +import Distribution.Utils.NubList ( NubListR, fromNubListR ) import Language.Haskell.Extension ( Language(..), Extension(..) ) +import qualified Data.Map as M import Data.Monoid +import Data.List ( intercalate ) -- | A structured set of GHC options/flags -- @@ -35,20 +38,20 @@ -- | Any extra options to pass directly to ghc. These go at the end and hence -- override other stuff. - ghcOptExtra :: [String], + ghcOptExtra :: NubListR String, -- | Extra default flags to pass directly to ghc. These go at the beginning -- and so can be overridden by other stuff. - ghcOptExtraDefault :: [String], + ghcOptExtraDefault :: NubListR String, ----------------------- -- Inputs and outputs -- | The main input files; could be .hs, .hi, .c, .o, depending on mode. - ghcOptInputFiles :: [FilePath], + ghcOptInputFiles :: NubListR FilePath, -- | The names of input Haskell modules, mainly for @--make@ mode. - ghcOptInputModules :: [ModuleName], + ghcOptInputModules :: NubListR ModuleName, -- | Location for output file; the @ghc -o@ flag. ghcOptOutputFile :: Flag FilePath, @@ -62,66 +65,73 @@ ghcOptSourcePathClear :: Flag Bool, -- | Search path for Haskell source files; the @ghc -i@ flag. - ghcOptSourcePath :: [FilePath], + ghcOptSourcePath :: NubListR FilePath, ------------- -- Packages - -- | The package name the modules will belong to; the @ghc -package-name@ flag - ghcOptPackageName :: Flag PackageId, + -- | The package key the modules will belong to; the @ghc -this-package-key@ + -- flag. + ghcOptPackageKey :: Flag PackageKey, - -- | GHC package databases to use, the @ghc -package-conf@ flag + -- | GHC package databases to use, the @ghc -package-conf@ flag. ghcOptPackageDBs :: PackageDBStack, -- | The GHC packages to use. For compatability with old and new ghc, this -- requires both the short and long form of the package id; -- the @ghc -package@ or @ghc -package-id@ flags. - ghcOptPackages :: [(InstalledPackageId, PackageId)], + ghcOptPackages :: + NubListR (InstalledPackageId, PackageId, ModuleRenaming), -- | Start with a clean package set; the @ghc -hide-all-packages@ flag ghcOptHideAllPackages :: Flag Bool, - -- | Don't automatically link in Haskell98 etc; the @ghc -no-auto-link-packages@ flag. + -- | Don't automatically link in Haskell98 etc; the @ghc + -- -no-auto-link-packages@ flag. ghcOptNoAutoLinkPackages :: Flag Bool, + -- | What packages are implementing the signatures + ghcOptSigOf :: [(ModuleName, (PackageKey, ModuleName))], + ----------------- -- Linker stuff -- | Names of libraries to link in; the @ghc -l@ flag. - ghcOptLinkLibs :: [FilePath], + ghcOptLinkLibs :: NubListR FilePath, -- | Search path for libraries to link in; the @ghc -L@ flag. - ghcOptLinkLibPath :: [FilePath], + ghcOptLinkLibPath :: NubListR FilePath, -- | Options to pass through to the linker; the @ghc -optl@ flag. - ghcOptLinkOptions :: [String], + ghcOptLinkOptions :: NubListR String, -- | OSX only: frameworks to link in; the @ghc -framework@ flag. - ghcOptLinkFrameworks :: [String], + ghcOptLinkFrameworks :: NubListR String, -- | Don't do the link step, useful in make mode; the @ghc -no-link@ flag. ghcOptNoLink :: Flag Bool, - -- | Don't link in the normal RTS @main@ entry point; the @ghc -no-hs-main@ flag. + -- | Don't link in the normal RTS @main@ entry point; the @ghc -no-hs-main@ + -- flag. ghcOptLinkNoHsMain :: Flag Bool, -------------------- -- C and CPP stuff -- | Options to pass through to the C compiler; the @ghc -optc@ flag. - ghcOptCcOptions :: [String], + ghcOptCcOptions :: NubListR String, -- | Options to pass through to CPP; the @ghc -optP@ flag. - ghcOptCppOptions :: [String], + ghcOptCppOptions :: NubListR String, -- | Search path for CPP includes like header files; the @ghc -I@ flag. - ghcOptCppIncludePath :: [FilePath], + ghcOptCppIncludePath :: NubListR FilePath, -- | Extra header files to include at CPP stage; the @ghc -optP-include@ flag. - ghcOptCppIncludes :: [FilePath], + ghcOptCppIncludes :: NubListR FilePath, -- | Extra header files to include for old-style FFI; the @ghc -#include@ flag. - ghcOptFfiIncludes :: [FilePath], + ghcOptFfiIncludes :: NubListR FilePath, ---------------------------- -- Language and extensions @@ -130,11 +140,11 @@ ghcOptLanguage :: Flag Language, -- | The language extensions; the @ghc -X@ flag. - ghcOptExtensions :: [Extension], + ghcOptExtensions :: NubListR Extension, -- | A GHC version-dependent mapping of extensions to flags. This must be -- set to be able to make use of the 'ghcOptExtensions'. - ghcOptExtensionMap :: [(Extension, String)], + ghcOptExtensionMap :: M.Map Extension String, ---------------- -- Compilation @@ -142,6 +152,9 @@ -- | What optimisation level to use; the @ghc -O@ flag. ghcOptOptimisation :: Flag GhcOptimisation, + -- | Emit debug info; the @ghc -g@ flag. + ghcOptDebugInfo :: Flag Bool, + -- | Compile in profiling mode; the @ghc -prof@ flag. ghcOptProfilingMode :: Flag Bool, @@ -149,13 +162,16 @@ ghcOptSplitObjs :: Flag Bool, -- | Run N jobs simultaneously (if possible). - ghcOptNumJobs :: Flag Int, + ghcOptNumJobs :: Flag (Maybe Int), + -- | Enable coverage analysis; the @ghc -fhpc -hpcdir@ flags. + ghcOptHPCDir :: Flag FilePath, + ---------------- -- GHCi -- | Extra GHCi startup scripts; the @-ghci-script@ flag - ghcOptGHCiScripts :: [FilePath], + ghcOptGHCiScripts :: NubListR FilePath, ------------------------ -- Redirecting outputs @@ -176,6 +192,7 @@ ghcOptShared :: Flag Bool, ghcOptFPic :: Flag Bool, ghcOptDylibName :: Flag String, + ghcOptRPaths :: NubListR FilePath, --------------- -- Misc flags @@ -220,12 +237,11 @@ ghcInvocation prog comp opts = programInvocation prog (renderGhcOptions comp opts) - renderGhcOptions :: Compiler -> GhcOptions -> [String] renderGhcOptions comp opts - | compilerFlavor comp /= GHC = + | compilerFlavor comp `notElem` [GHC, GHCJS] = error $ "Distribution.Simple.Program.GHC.renderGhcOptions: " - ++ "compiler flavor must be 'GHC'!" + ++ "compiler flavor must be 'GHC' or 'GHCJS'!" | otherwise = concat [ case flagToMaybe (ghcOptMode opts) of @@ -247,7 +263,8 @@ , maybe [] verbosityOpts (flagToMaybe (ghcOptVerbosity opts)) - , [ "-fbuilding-cabal-package" | flagBool ghcOptCabal, ver >= [6,11] ] + , [ "-fbuilding-cabal-package" | flagBool ghcOptCabal + , flagBuildingCabalPkg implInfo ] ---------------- -- Compilation @@ -259,15 +276,20 @@ Just GhcMaximumOptimisation -> ["-O2"] Just (GhcSpecialOptimisation s) -> ["-O" ++ s] -- eg -Odph + , [ "-g" | flagDebugInfo implInfo && flagBool ghcOptDebugInfo ] + , [ "-prof" | flagBool ghcOptProfilingMode ] , [ "-split-objs" | flagBool ghcOptSplitObjs ] + , case flagToMaybe (ghcOptHPCDir opts) of + Nothing -> [] + Just hpcdir -> ["-fhpc", "-hpcdir", hpcdir] , if parmakeSupported comp - then - let numJobs = fromFlagOrDefault 1 (ghcOptNumJobs opts) - in if numJobs > 1 then ["-j" ++ show numJobs] else [] + then case ghcOptNumJobs opts of + NoFlag -> [] + Flag n -> ["-j" ++ maybe "" show n] else [] -------------------- @@ -290,10 +312,12 @@ , concat [ ["-hisuf", suf] | suf <- flag ghcOptHiSuffix ] , concat [ ["-dynosuf", suf] | suf <- flag ghcOptDynObjSuffix ] , concat [ ["-dynhisuf",suf] | suf <- flag ghcOptDynHiSuffix ] - , concat [ ["-outputdir", dir] | dir <- flag ghcOptOutputDir, ver >= [6,10] ] + , concat [ ["-outputdir", dir] | dir <- flag ghcOptOutputDir + , flagOutputDir implInfo ] , concat [ ["-odir", dir] | dir <- flag ghcOptObjDir ] , concat [ ["-hidir", dir] | dir <- flag ghcOptHiDir ] - , concat [ ["-stubdir", dir] | dir <- flag ghcOptStubDir, ver >= [6,8] ] + , concat [ ["-stubdir", dir] | dir <- flag ghcOptStubDir + , flagStubdir implInfo ] ----------------------- -- Source search path @@ -306,8 +330,10 @@ , [ "-I" ++ dir | dir <- flags ghcOptCppIncludePath ] , [ "-optP" ++ opt | opt <- flags ghcOptCppOptions ] - , concat [ [ "-optP-include", "-optP" ++ inc] | inc <- flags ghcOptCppIncludes ] - , [ "-#include \"" ++ inc ++ "\"" | inc <- flags ghcOptFfiIncludes, ver < [6,11] ] + , concat [ [ "-optP-include", "-optP" ++ inc] + | inc <- flags ghcOptCppIncludes ] + , [ "-#include \"" ++ inc ++ "\"" + | inc <- flags ghcOptFfiIncludes, flagFfiIncludes implInfo ] , [ "-optc" ++ opt | opt <- flags ghcOptCcOptions ] ----------------- @@ -318,45 +344,64 @@ , ["-L" ++ dir | dir <- flags ghcOptLinkLibPath ] , concat [ ["-framework", fmwk] | fmwk <- flags ghcOptLinkFrameworks ] , [ "-no-hs-main" | flagBool ghcOptLinkNoHsMain ] + , [ "-dynload deploy" | not (null (flags ghcOptRPaths)) ] + , concat [ [ "-optl-Wl,-rpath," ++ dir] + | dir <- flags ghcOptRPaths ] ------------- -- Packages - , concat [ ["-package-name", display pkgid] | pkgid <- flag ghcOptPackageName ] + , concat [ [if packageKeySupported comp + then "-this-package-key" + else "-package-name", display pkgid] + | pkgid <- flag ghcOptPackageKey ] , [ "-hide-all-packages" | flagBool ghcOptHideAllPackages ] , [ "-no-auto-link-packages" | flagBool ghcOptNoAutoLinkPackages ] - , packageDbArgs version (flags ghcOptPackageDBs) + , packageDbArgs implInfo (ghcOptPackageDBs opts) - , concat $ if ver >= [6,11] - then [ ["-package-id", display ipkgid] | (ipkgid,_) <- flags ghcOptPackages ] - else [ ["-package", display pkgid] | (_,pkgid) <- flags ghcOptPackages ] + , if null (ghcOptSigOf opts) + then [] + else "-sig-of" + : intercalate "," (map (\(n,(p,m)) -> display n ++ " is " + ++ display p ++ ":" + ++ display m) + (ghcOptSigOf opts)) + : [] + , concat $ if flagPackageId implInfo + then let space "" = "" + space xs = ' ' : xs + in [ ["-package-id", display ipkgid ++ space (display rns)] + | (ipkgid,_,rns) <- flags ghcOptPackages ] + else [ ["-package", display pkgid] + | (_,pkgid,_) <- flags ghcOptPackages ] + ---------------------------- -- Language and extensions - , if ver >= [7] + , if supportsHaskell2010 implInfo then [ "-X" ++ display lang | lang <- flag ghcOptLanguage ] else [] - , [ case lookup ext (ghcOptExtensionMap opts) of + , [ case M.lookup ext (ghcOptExtensionMap opts) of Just arg -> arg Nothing -> error $ "Distribution.Simple.Program.GHC.renderGhcOptions: " ++ display ext ++ " not present in ghcOptExtensionMap." - | ext <- ghcOptExtensions opts ] + | ext <- flags ghcOptExtensions ] ---------------- -- GHCi , concat [ [ "-ghci-script", script ] | script <- flags ghcOptGHCiScripts - , ver >= [7,2] ] + , flagGhciScript implInfo ] --------------- -- Inputs , [ display modu | modu <- flags ghcOptInputModules ] - , ghcOptInputFiles opts + , flags ghcOptInputFiles , concat [ [ "-o", out] | out <- flag ghcOptOutputFile ] , concat [ [ "-dyno", out] | out <- flag ghcOptOutputDynFile ] @@ -364,18 +409,17 @@ --------------- -- Extra - , ghcOptExtra opts + , flags ghcOptExtra ] where + implInfo = getImplInfo comp flag flg = flagToList (flg opts) - flags flg = flg opts + flags flg = fromNubListR . flg $ opts flagBool flg = fromFlagOrDefault False (flg opts) - version@(Version ver _) = compilerVersion comp - verbosityOpts :: Verbosity -> [String] verbosityOpts verbosity | verbosity >= deafening = ["-v"] @@ -383,8 +427,8 @@ | otherwise = ["-w", "-v0"] -packageDbArgs :: Version -> PackageDBStack -> [String] -packageDbArgs (Version ver _) dbstack = case dbstack of +packageDbArgs :: GhcImplInfo -> PackageDBStack -> [String] +packageDbArgs implInfo dbstack = case dbstack of (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs (GlobalPackageDB:dbs) -> ("-no-user-" ++ packageDbFlag) : concatMap specific dbs @@ -394,9 +438,8 @@ specific _ = ierror ierror = error $ "internal error: unexpected package db stack: " ++ show dbstack - packageDbFlag - | ver < [7,5] + | flagPackageConf implInfo = "package-conf" | otherwise = "package-db" @@ -416,11 +459,12 @@ ghcOptOutputDynFile = mempty, ghcOptSourcePathClear = mempty, ghcOptSourcePath = mempty, - ghcOptPackageName = mempty, + ghcOptPackageKey = mempty, ghcOptPackageDBs = mempty, ghcOptPackages = mempty, ghcOptHideAllPackages = mempty, ghcOptNoAutoLinkPackages = mempty, + ghcOptSigOf = mempty, ghcOptLinkLibs = mempty, ghcOptLinkLibPath = mempty, ghcOptLinkOptions = mempty, @@ -436,9 +480,11 @@ ghcOptExtensions = mempty, ghcOptExtensionMap = mempty, ghcOptOptimisation = mempty, + ghcOptDebugInfo = mempty, ghcOptProfilingMode = mempty, ghcOptSplitObjs = mempty, ghcOptNumJobs = mempty, + ghcOptHPCDir = mempty, ghcOptGHCiScripts = mempty, ghcOptHiSuffix = mempty, ghcOptObjSuffix = mempty, @@ -452,6 +498,7 @@ ghcOptShared = mempty, ghcOptFPic = mempty, ghcOptDylibName = mempty, + ghcOptRPaths = mempty, ghcOptVerbosity = mempty, ghcOptCabal = mempty } @@ -465,11 +512,12 @@ ghcOptOutputDynFile = combine ghcOptOutputDynFile, ghcOptSourcePathClear = combine ghcOptSourcePathClear, ghcOptSourcePath = combine ghcOptSourcePath, - ghcOptPackageName = combine ghcOptPackageName, + ghcOptPackageKey = combine ghcOptPackageKey, ghcOptPackageDBs = combine ghcOptPackageDBs, ghcOptPackages = combine ghcOptPackages, ghcOptHideAllPackages = combine ghcOptHideAllPackages, ghcOptNoAutoLinkPackages = combine ghcOptNoAutoLinkPackages, + ghcOptSigOf = combine ghcOptSigOf, ghcOptLinkLibs = combine ghcOptLinkLibs, ghcOptLinkLibPath = combine ghcOptLinkLibPath, ghcOptLinkOptions = combine ghcOptLinkOptions, @@ -485,9 +533,11 @@ ghcOptExtensions = combine ghcOptExtensions, ghcOptExtensionMap = combine ghcOptExtensionMap, ghcOptOptimisation = combine ghcOptOptimisation, + ghcOptDebugInfo = combine ghcOptDebugInfo, ghcOptProfilingMode = combine ghcOptProfilingMode, ghcOptSplitObjs = combine ghcOptSplitObjs, ghcOptNumJobs = combine ghcOptNumJobs, + ghcOptHPCDir = combine ghcOptHPCDir, ghcOptGHCiScripts = combine ghcOptGHCiScripts, ghcOptHiSuffix = combine ghcOptHiSuffix, ghcOptObjSuffix = combine ghcOptObjSuffix, @@ -501,6 +551,7 @@ ghcOptShared = combine ghcOptShared, ghcOptFPic = combine ghcOptFPic, ghcOptDylibName = combine ghcOptDylibName, + ghcOptRPaths = combine ghcOptRPaths, ghcOptVerbosity = combine ghcOptVerbosity, ghcOptCabal = combine ghcOptCabal } diff --git a/Distribution/Simple/Program/HcPkg.hs b/Distribution/Simple/Program/HcPkg.hs --- a/Distribution/Simple/Program/HcPkg.hs +++ b/Distribution/Simple/Program/HcPkg.hs @@ -7,9 +7,11 @@ -- Portability : portable -- -- This module provides an library interface to the @hc-pkg@ program. --- Currently only GHC and LHC have hc-pkg programs. +-- Currently only GHC, GHCJS and LHC have hc-pkg programs. module Distribution.Simple.Program.HcPkg ( + HcPkgInfo(..), + init, invoke, register, @@ -42,12 +44,10 @@ import Distribution.Simple.Compiler ( PackageDB(..), PackageDBStack ) import Distribution.Simple.Program.Types - ( ConfiguredProgram(programId, programVersion) ) + ( ConfiguredProgram(programId) ) import Distribution.Simple.Program.Run ( ProgramInvocation(..), IOEncoding(..), programInvocation , runProgramInvocation, getProgramInvocationOutput ) -import Distribution.Version - ( Version(..) ) import Distribution.Text ( display, simpleParse ) import Distribution.Simple.Utils @@ -59,127 +59,122 @@ import Data.Char ( isSpace ) -import Data.Maybe - ( fromMaybe ) import Data.List ( stripPrefix ) import System.FilePath as FilePath ( (), splitPath, splitDirectories, joinPath, isPathSeparator ) import qualified System.FilePath.Posix as FilePath.Posix +-- | Information about the features and capabilities of an @hc-pkg@ +-- program. +-- +data HcPkgInfo = HcPkgInfo + { hcPkgProgram :: ConfiguredProgram + , noPkgDbStack :: Bool -- ^ no package DB stack supported + , noVerboseFlag :: Bool -- ^ hc-pkg does not support verbosity flags + , flagPackageConf :: Bool -- ^ use package-conf option instead of package-db + } -- | Call @hc-pkg@ to initialise a package database at the location {path}. -- -- > hc-pkg init {path} -- -init :: Verbosity -> ConfiguredProgram -> FilePath -> IO () -init verbosity hcPkg path = - runProgramInvocation verbosity - (initInvocation hcPkg verbosity path) +init :: HcPkgInfo -> Verbosity -> FilePath -> IO () +init hpi verbosity path = + runProgramInvocation verbosity (initInvocation hpi verbosity path) -- | Run @hc-pkg@ using a given package DB stack, directly forwarding the -- provided command-line arguments to it. -invoke :: Verbosity -> ConfiguredProgram -> PackageDBStack -> [String] -> IO () -invoke verbosity hcPkg dbStack extraArgs = +invoke :: HcPkgInfo -> Verbosity -> PackageDBStack -> [String] -> IO () +invoke hpi verbosity dbStack extraArgs = runProgramInvocation verbosity invocation where - args = packageDbStackOpts hcPkg dbStack ++ extraArgs - invocation = programInvocation hcPkg args + args = packageDbStackOpts hpi dbStack ++ extraArgs + invocation = programInvocation (hcPkgProgram hpi) args -- | Call @hc-pkg@ to register a package. -- -- > hc-pkg register {filename | -} [--user | --global | --package-db] -- -register :: Verbosity -> ConfiguredProgram -> PackageDBStack +register :: HcPkgInfo -> Verbosity -> PackageDBStack -> Either FilePath InstalledPackageInfo -> IO () -register verbosity hcPkg packagedb pkgFile = +register hpi verbosity packagedb pkgFile = runProgramInvocation verbosity - (registerInvocation hcPkg verbosity packagedb pkgFile) + (registerInvocation hpi verbosity packagedb pkgFile) -- | Call @hc-pkg@ to re-register a package. -- -- > hc-pkg register {filename | -} [--user | --global | --package-db] -- -reregister :: Verbosity -> ConfiguredProgram -> PackageDBStack +reregister :: HcPkgInfo -> Verbosity -> PackageDBStack -> Either FilePath InstalledPackageInfo -> IO () -reregister verbosity hcPkg packagedb pkgFile = +reregister hpi verbosity packagedb pkgFile = runProgramInvocation verbosity - (reregisterInvocation hcPkg verbosity packagedb pkgFile) + (reregisterInvocation hpi verbosity packagedb pkgFile) -- | Call @hc-pkg@ to unregister a package -- -- > hc-pkg unregister [pkgid] [--user | --global | --package-db] -- -unregister :: Verbosity -> ConfiguredProgram -> PackageDB -> PackageId -> IO () -unregister verbosity hcPkg packagedb pkgid = +unregister :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO () +unregister hpi verbosity packagedb pkgid = runProgramInvocation verbosity - (unregisterInvocation hcPkg verbosity packagedb pkgid) + (unregisterInvocation hpi verbosity packagedb pkgid) -- | Call @hc-pkg@ to expose a package. -- -- > hc-pkg expose [pkgid] [--user | --global | --package-db] -- -expose :: Verbosity -> ConfiguredProgram -> PackageDB -> PackageId -> IO () -expose verbosity hcPkg packagedb pkgid = +expose :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO () +expose hpi verbosity packagedb pkgid = runProgramInvocation verbosity - (exposeInvocation hcPkg verbosity packagedb pkgid) + (exposeInvocation hpi verbosity packagedb pkgid) --- | Call @hc-pkg@ to expose a package. +-- | Call @hc-pkg@ to hide a package. -- --- > hc-pkg expose [pkgid] [--user | --global | --package-db] +-- > hc-pkg hide [pkgid] [--user | --global | --package-db] -- -hide :: Verbosity -> ConfiguredProgram -> PackageDB -> PackageId -> IO () -hide verbosity hcPkg packagedb pkgid = +hide :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> IO () +hide hpi verbosity packagedb pkgid = runProgramInvocation verbosity - (hideInvocation hcPkg verbosity packagedb pkgid) + (hideInvocation hpi verbosity packagedb pkgid) -- | Call @hc-pkg@ to get all the details of all the packages in the given -- package database. -- -dump :: Verbosity -> ConfiguredProgram -> PackageDB -> IO [InstalledPackageInfo] -dump verbosity hcPkg packagedb = do +dump :: HcPkgInfo -> Verbosity -> PackageDB -> IO [InstalledPackageInfo] +dump hpi verbosity packagedb = do output <- getProgramInvocationOutput verbosity - (dumpInvocation hcPkg verbosity packagedb) - `catchExit` \_ -> die $ programId hcPkg ++ " dump failed" + (dumpInvocation hpi verbosity packagedb) + `catchExit` \_ -> die $ programId (hcPkgProgram hpi) ++ " dump failed" case parsePackages output of Left ok -> return ok _ -> die $ "failed to parse output of '" - ++ programId hcPkg ++ " dump'" + ++ programId (hcPkgProgram hpi) ++ " dump'" where parsePackages str = let parsed = map parseInstalledPackageInfo' (splitPkgs str) in case [ msg | ParseFailed msg <- parsed ] of [] -> Left [ setInstalledPackageId - . maybe id mungePackagePaths pkgroot + . maybe id mungePackagePaths (pkgRoot pkg) $ pkg - | ParseOk _ (pkgroot, pkg) <- parsed ] + | ParseOk _ pkg <- parsed ] msgs -> Right msgs parseInstalledPackageInfo' = - parseFieldsFlat fields (Nothing, emptyInstalledPackageInfo) - where - fields = liftFieldFst pkgrootField - : map liftFieldSnd fieldsInstalledPackageInfo - - pkgrootField = - simpleField "pkgroot" - showFilePath parseFilePathQ - (fromMaybe "") (\x _ -> Just x) - - liftFieldFst = liftField fst (\x (_x,y) -> (x,y)) - liftFieldSnd = liftField snd (\y (x,_y) -> (x,y)) + parseFieldsFlat fieldsInstalledPackageInfo emptyInstalledPackageInfo --TODO: this could be a lot faster. We're doing normaliseLineEndings twice -- and converting back and forth with lines/unlines. @@ -256,162 +251,145 @@ -- Note in particular that it does not include the 'InstalledPackageId', just -- the source 'PackageId' which is not necessarily unique in any package db. -- -list :: Verbosity -> ConfiguredProgram -> PackageDB -> IO [PackageId] -list verbosity hcPkg packagedb = do +list :: HcPkgInfo -> Verbosity -> PackageDB + -> IO [PackageId] +list hpi verbosity packagedb = do output <- getProgramInvocationOutput verbosity - (listInvocation hcPkg verbosity packagedb) - `catchExit` \_ -> die $ programId hcPkg ++ " list failed" + (listInvocation hpi verbosity packagedb) + `catchExit` \_ -> die $ programId (hcPkgProgram hpi) ++ " list failed" case parsePackageIds output of Just ok -> return ok _ -> die $ "failed to parse output of '" - ++ programId hcPkg ++ " list'" + ++ programId (hcPkgProgram hpi) ++ " list'" where - parsePackageIds str = - let parsed = map simpleParse (words str) - in case [ () | Nothing <- parsed ] of - [] -> Just [ pkgid | Just pkgid <- parsed ] - _ -> Nothing - + parsePackageIds = sequence . map simpleParse . words -------------------------- -- The program invocations -- -initInvocation :: ConfiguredProgram - -> Verbosity -> FilePath -> ProgramInvocation -initInvocation hcPkg verbosity path = - programInvocation hcPkg args +initInvocation :: HcPkgInfo -> Verbosity -> FilePath -> ProgramInvocation +initInvocation hpi verbosity path = + programInvocation (hcPkgProgram hpi) args where args = ["init", path] - ++ verbosityOpts hcPkg verbosity + ++ verbosityOpts hpi verbosity registerInvocation, reregisterInvocation - :: ConfiguredProgram -> Verbosity -> PackageDBStack + :: HcPkgInfo -> Verbosity -> PackageDBStack -> Either FilePath InstalledPackageInfo -> ProgramInvocation registerInvocation = registerInvocation' "register" reregisterInvocation = registerInvocation' "update" -registerInvocation' :: String - -> ConfiguredProgram -> Verbosity -> PackageDBStack +registerInvocation' :: String -> HcPkgInfo -> Verbosity -> PackageDBStack -> Either FilePath InstalledPackageInfo -> ProgramInvocation -registerInvocation' cmdname hcPkg verbosity packagedbs (Left pkgFile) = - programInvocation hcPkg args +registerInvocation' cmdname hpi verbosity packagedbs (Left pkgFile) = + programInvocation (hcPkgProgram hpi) args where args = [cmdname, pkgFile] - ++ (if legacyVersion hcPkg - then [packageDbOpts hcPkg (last packagedbs)] - else packageDbStackOpts hcPkg packagedbs) - ++ verbosityOpts hcPkg verbosity + ++ (if noPkgDbStack hpi + then [packageDbOpts hpi (last packagedbs)] + else packageDbStackOpts hpi packagedbs) + ++ verbosityOpts hpi verbosity -registerInvocation' cmdname hcPkg verbosity packagedbs (Right pkgInfo) = - (programInvocation hcPkg args) { +registerInvocation' cmdname hpi verbosity packagedbs (Right pkgInfo) = + (programInvocation (hcPkgProgram hpi) args) { progInvokeInput = Just (showInstalledPackageInfo pkgInfo), progInvokeInputEncoding = IOEncodingUTF8 } where args = [cmdname, "-"] - ++ (if legacyVersion hcPkg - then [packageDbOpts hcPkg (last packagedbs)] - else packageDbStackOpts hcPkg packagedbs) - ++ verbosityOpts hcPkg verbosity + ++ (if noPkgDbStack hpi + then [packageDbOpts hpi (last packagedbs)] + else packageDbStackOpts hpi packagedbs) + ++ verbosityOpts hpi verbosity -unregisterInvocation :: ConfiguredProgram - -> Verbosity -> PackageDB -> PackageId +unregisterInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId -> ProgramInvocation -unregisterInvocation hcPkg verbosity packagedb pkgid = - programInvocation hcPkg $ - ["unregister", packageDbOpts hcPkg packagedb, display pkgid] - ++ verbosityOpts hcPkg verbosity +unregisterInvocation hpi verbosity packagedb pkgid = + programInvocation (hcPkgProgram hpi) $ + ["unregister", packageDbOpts hpi packagedb, display pkgid] + ++ verbosityOpts hpi verbosity -exposeInvocation :: ConfiguredProgram - -> Verbosity -> PackageDB -> PackageId -> ProgramInvocation -exposeInvocation hcPkg verbosity packagedb pkgid = - programInvocation hcPkg $ - ["expose", packageDbOpts hcPkg packagedb, display pkgid] - ++ verbosityOpts hcPkg verbosity +exposeInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId + -> ProgramInvocation +exposeInvocation hpi verbosity packagedb pkgid = + programInvocation (hcPkgProgram hpi) $ + ["expose", packageDbOpts hpi packagedb, display pkgid] + ++ verbosityOpts hpi verbosity -hideInvocation :: ConfiguredProgram - -> Verbosity -> PackageDB -> PackageId -> ProgramInvocation -hideInvocation hcPkg verbosity packagedb pkgid = - programInvocation hcPkg $ - ["hide", packageDbOpts hcPkg packagedb, display pkgid] - ++ verbosityOpts hcPkg verbosity +hideInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId + -> ProgramInvocation +hideInvocation hpi verbosity packagedb pkgid = + programInvocation (hcPkgProgram hpi) $ + ["hide", packageDbOpts hpi packagedb, display pkgid] + ++ verbosityOpts hpi verbosity -dumpInvocation :: ConfiguredProgram - -> Verbosity -> PackageDB -> ProgramInvocation -dumpInvocation hcPkg _verbosity packagedb = - (programInvocation hcPkg args) { +dumpInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation +dumpInvocation hpi _verbosity packagedb = + (programInvocation (hcPkgProgram hpi) args) { progInvokeOutputEncoding = IOEncodingUTF8 } where - args = ["dump", packageDbOpts hcPkg packagedb] - ++ verbosityOpts hcPkg silent + args = ["dump", packageDbOpts hpi packagedb] + ++ verbosityOpts hpi silent -- We use verbosity level 'silent' because it is important that we -- do not contaminate the output with info/debug messages. -listInvocation :: ConfiguredProgram - -> Verbosity -> PackageDB -> ProgramInvocation -listInvocation hcPkg _verbosity packagedb = - (programInvocation hcPkg args) { +listInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> ProgramInvocation +listInvocation hpi _verbosity packagedb = + (programInvocation (hcPkgProgram hpi) args) { progInvokeOutputEncoding = IOEncodingUTF8 } where - args = ["list", "--simple-output", packageDbOpts hcPkg packagedb] - ++ verbosityOpts hcPkg silent + args = ["list", "--simple-output", packageDbOpts hpi packagedb] + ++ verbosityOpts hpi silent -- We use verbosity level 'silent' because it is important that we -- do not contaminate the output with info/debug messages. -packageDbStackOpts :: ConfiguredProgram -> PackageDBStack -> [String] -packageDbStackOpts hcPkg dbstack = case dbstack of +packageDbStackOpts :: HcPkgInfo -> PackageDBStack -> [String] +packageDbStackOpts hpi dbstack = case dbstack of (GlobalPackageDB:UserPackageDB:dbs) -> "--global" : "--user" : map specific dbs (GlobalPackageDB:dbs) -> "--global" - : ("--no-user-" ++ packageDbFlag hcPkg) + : ("--no-user-" ++ packageDbFlag hpi) : map specific dbs _ -> ierror where - specific (SpecificPackageDB db) = "--" ++ packageDbFlag hcPkg ++ "=" ++ db + specific (SpecificPackageDB db) = "--" ++ packageDbFlag hpi ++ "=" ++ db specific _ = ierror ierror :: a ierror = error ("internal error: unexpected package db stack: " ++ show dbstack) -packageDbFlag :: ConfiguredProgram -> String -packageDbFlag hcPkg - | programVersion hcPkg < Just (Version [7,5] []) +packageDbFlag :: HcPkgInfo -> String +packageDbFlag hpi + | flagPackageConf hpi = "package-conf" | otherwise = "package-db" -packageDbOpts :: ConfiguredProgram -> PackageDB -> String +packageDbOpts :: HcPkgInfo -> PackageDB -> String packageDbOpts _ GlobalPackageDB = "--global" packageDbOpts _ UserPackageDB = "--user" -packageDbOpts hcPkg (SpecificPackageDB db) = "--" ++ packageDbFlag hcPkg ++ "=" ++ db - -verbosityOpts :: ConfiguredProgram -> Verbosity -> [String] -verbosityOpts hcPkg v +packageDbOpts hpi (SpecificPackageDB db) = "--" ++ packageDbFlag hpi ++ "=" ++ db - -- ghc-pkg < 6.11 does not support -v - | programId hcPkg == "ghc-pkg" - && programVersion hcPkg < Just (Version [6,11] []) +verbosityOpts :: HcPkgInfo -> Verbosity -> [String] +verbosityOpts hpi v + | noVerboseFlag hpi = [] - | v >= deafening = ["-v2"] | v == silent = ["-v0"] | otherwise = [] --- Handle quirks in ghc-pkg 6.8 and older -legacyVersion :: ConfiguredProgram -> Bool -legacyVersion hcPkg = programId hcPkg == "ghc-pkg" - && programVersion hcPkg < Just (Version [6,9] []) diff --git a/Distribution/Simple/Program/Hpc.hs b/Distribution/Simple/Program/Hpc.hs --- a/Distribution/Simple/Program/Hpc.hs +++ b/Distribution/Simple/Program/Hpc.hs @@ -55,7 +55,7 @@ runProgramInvocation verbosity (markupInvocation hpc tixFile hpcDirs' destDir excluded) where - version07 = Version { versionBranch = [0, 7], versionTags = [] } + version07 = Version [0, 7] [] (passedDirs, droppedDirs) = splitAt 1 hpcDirs markupInvocation :: ConfiguredProgram diff --git a/Distribution/Simple/Program/Run.hs b/Distribution/Simple/Program/Run.hs --- a/Distribution/Simple/Program/Run.hs +++ b/Distribution/Simple/Program/Run.hs @@ -133,7 +133,7 @@ mcwd menv (Just input) True when (exitCode /= ExitSuccess) $ - die errors + die $ "'" ++ path ++ "' exited with an error:\n" ++ errors where input = case encoding of IOEncodingText -> (inputStr, False) @@ -160,7 +160,7 @@ mcwd menv input utf8 when (exitCode /= ExitSuccess) $ - die errors + die $ "'" ++ path ++ "' exited with an error:\n" ++ errors return (decode output) where input = diff --git a/Distribution/Simple/Program/Types.hs b/Distribution/Simple/Program/Types.hs --- a/Distribution/Simple/Program/Types.hs +++ b/Distribution/Simple/Program/Types.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.Program.Types @@ -38,6 +40,10 @@ import Distribution.Verbosity ( Verbosity ) +import Data.Binary (Binary) +import qualified Data.Map as Map +import GHC.Generics (Generic) + -- | Represents a program which can be configured. -- -- Note: rather than constructing this directly, start with 'simpleProgram' and @@ -96,10 +102,17 @@ -- the current to form the environment for the new process. programOverrideEnv :: [(String, Maybe String)], + -- | A key-value map listing various properties of the program, useful + -- for feature detection. Populated during the configuration step, key + -- names depend on the specific program. + programProperties :: Map.Map String String, + -- | Location of the program. eg. @\/usr\/bin\/ghc-6.4@ programLocation :: ProgramLocation - } deriving (Read, Show, Eq) + } deriving (Eq, Generic, Read, Show) +instance Binary ConfiguredProgram + -- | Where a program was found. Also tells us whether it's specified by user or -- not. This includes not just the path, but the program as well. data ProgramLocation @@ -108,8 +121,10 @@ -- eg. --ghc-path=\/usr\/bin\/ghc-6.6 | FoundOnSystem { locationPath :: FilePath } -- ^The program was found automatically. - deriving (Read, Show, Eq) + deriving (Eq, Generic, Read, Show) +instance Binary ProgramLocation + -- | The full path of a configured program. programPath :: ConfiguredProgram -> FilePath programPath = locationPath . programLocation @@ -144,5 +159,6 @@ programDefaultArgs = [], programOverrideArgs = [], programOverrideEnv = [], + programProperties = Map.empty, programLocation = loc } diff --git a/Distribution/Simple/Register.hs b/Distribution/Simple/Register.hs --- a/Distribution/Simple/Register.hs +++ b/Distribution/Simple/Register.hs @@ -42,26 +42,28 @@ , LibraryName(..) , InstallDirs(..), absoluteInstallDirs ) import Distribution.Simple.BuildPaths (haddockName) -import qualified Distribution.Simple.GHC as GHC -import qualified Distribution.Simple.LHC as LHC -import qualified Distribution.Simple.Hugs as Hugs -import qualified Distribution.Simple.UHC as UHC + +import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.GHCJS as GHCJS +import qualified Distribution.Simple.LHC as LHC +import qualified Distribution.Simple.UHC as UHC import qualified Distribution.Simple.HaskellSuite as HaskellSuite + import Distribution.Simple.Compiler ( compilerVersion, Compiler, CompilerFlavor(..), compilerFlavor - , PackageDBStack, registrationPackageDB ) + , PackageDB, PackageDBStack, absolutePackageDBPaths + , registrationPackageDB ) import Distribution.Simple.Program - ( ProgramConfiguration, ConfiguredProgram - , runProgramInvocation, requireProgram, lookupProgram - , ghcPkgProgram, lhcPkgProgram ) + ( ProgramConfiguration, runProgramInvocation ) import Distribution.Simple.Program.Script ( invocationAsSystemScript ) +import Distribution.Simple.Program.HcPkg (HcPkgInfo) import qualified Distribution.Simple.Program.HcPkg as HcPkg import Distribution.Simple.Setup ( RegisterFlags(..), CopyDest(..) , fromFlag, fromFlagOrDefault, flagToMaybe ) import Distribution.PackageDescription - ( PackageDescription(..), Library(..), BuildInfo(..), hcOptions ) + ( PackageDescription(..), Library(..), BuildInfo(..), libModules ) import Distribution.Package ( Package(..), packageName, InstalledPackageId(..) ) import Distribution.InstalledPackageInfo @@ -70,7 +72,7 @@ import qualified Distribution.InstalledPackageInfo as IPI import Distribution.Simple.Utils ( writeUTF8File, writeFileAtomic, setFileExecutable - , die, notice, setupMessage ) + , die, notice, setupMessage, shortRelativePath ) import Distribution.System ( OS(..), buildOS ) import Distribution.Text @@ -78,13 +80,12 @@ import Distribution.Version ( Version(..) ) import Distribution.Verbosity as Verbosity ( Verbosity, normal ) -import Distribution.Compat.Exception - ( tryIO ) import System.FilePath ((), (<.>), isAbsolute) import System.Directory - ( getCurrentDirectory, removeDirectoryRecursive ) + ( getCurrentDirectory ) +import Control.Monad (when) import Data.Maybe ( isJust, fromMaybe, maybeToList ) import Data.List @@ -100,9 +101,15 @@ register pkg@PackageDescription { library = Just lib } lbi regFlags = do let clbi = getComponentLocalBuildInfo lbi CLibName + + absPackageDBs <- absolutePackageDBPaths packageDbs installedPkgInfo <- generateRegistrationInfo - verbosity pkg lib lbi clbi inplace distPref + verbosity pkg lib lbi clbi inplace reloc distPref + (registrationPackageDB absPackageDBs) + when (fromFlag (regPrintId regFlags)) $ do + putStrLn (display (IPI.installedPackageId installedPkgInfo)) + -- Three different modes: case () of _ | modeGenerateRegFile -> writeRegistrationFile installedPkgInfo @@ -118,6 +125,7 @@ modeGenerateRegScript = fromFlag (regGenScript regFlags) inplace = fromFlag (regInPlace regFlags) + reloc = relocatable lbi -- FIXME: there's really no guarantee this will work. -- registering into a totally different db stack can -- fail if dependencies cannot be satisfied. @@ -132,15 +140,12 @@ writeRegisterScript installedPkgInfo = case compilerFlavor (compiler lbi) of - GHC -> do (ghcPkg, _) <- requireProgram verbosity ghcPkgProgram (withPrograms lbi) - writeHcPkgRegisterScript verbosity installedPkgInfo ghcPkg packageDbs - LHC -> do (lhcPkg, _) <- requireProgram verbosity lhcPkgProgram (withPrograms lbi) - writeHcPkgRegisterScript verbosity installedPkgInfo lhcPkg packageDbs - Hugs -> notice verbosity "Registration scripts not needed for hugs" - JHC -> notice verbosity "Registration scripts not needed for jhc" - NHC -> notice verbosity "Registration scripts not needed for nhc98" - UHC -> notice verbosity "Registration scripts not needed for uhc" - _ -> die "Registration scripts are not implemented for this compiler" + JHC -> notice verbosity "Registration scripts not needed for jhc" + UHC -> notice verbosity "Registration scripts not needed for uhc" + _ -> withHcPkg + "Registration scripts are not implemented for this compiler" + (compiler lbi) (withPrograms lbi) + (writeHcPkgRegisterScript verbosity installedPkgInfo packageDbs) register _ _ regFlags = notice verbosity "No package to register" where @@ -153,9 +158,11 @@ -> LocalBuildInfo -> ComponentLocalBuildInfo -> Bool + -> Bool -> FilePath + -> PackageDB -> IO InstalledPackageInfo -generateRegistrationInfo verbosity pkg lib lbi clbi inplace distPref = do +generateRegistrationInfo verbosity pkg lib lbi clbi inplace reloc distPref packageDb = do --TODO: eliminate pwd! pwd <- getCurrentDirectory @@ -167,38 +174,69 @@ GHC | compilerVersion comp >= Version [6,11] [] -> do s <- GHC.libAbiHash verbosity pkg lbi lib clbi return (InstalledPackageId (display (packageId pkg) ++ '-':s)) + GHCJS -> do + s <- GHCJS.libAbiHash verbosity pkg lbi lib clbi + return (InstalledPackageId (display (packageId pkg) ++ '-':s)) _other -> do return (InstalledPackageId (display (packageId pkg))) - let installedPkgInfo - | inplace = inplaceInstalledPackageInfo pwd distPref - pkg lib lbi clbi - | otherwise = absoluteInstalledPackageInfo - pkg lib lbi clbi + installedPkgInfo <- + if inplace + then return (inplaceInstalledPackageInfo pwd distPref + pkg ipid lib lbi clbi) + else if reloc + then relocRegistrationInfo verbosity + pkg lib lbi clbi ipid packageDb + else return (absoluteInstalledPackageInfo + pkg ipid lib lbi clbi) + return installedPkgInfo{ IPI.installedPackageId = ipid } +relocRegistrationInfo :: Verbosity + -> PackageDescription + -> Library + -> LocalBuildInfo + -> ComponentLocalBuildInfo + -> InstalledPackageId + -> PackageDB + -> IO InstalledPackageInfo +relocRegistrationInfo verbosity pkg lib lbi clbi ipid packageDb = + case (compilerFlavor (compiler lbi)) of + GHC -> do fs <- GHC.pkgRoot verbosity lbi packageDb + return (relocatableInstalledPackageInfo + pkg ipid lib lbi clbi fs) + _ -> die "Distribution.Simple.Register.relocRegistrationInfo: \ + \not implemented for this compiler" -- | Create an empty package DB at the specified location. initPackageDB :: Verbosity -> Compiler -> ProgramConfiguration -> FilePath -> IO () initPackageDB verbosity comp conf dbPath = - case (compilerFlavor comp) of - GHC -> GHC.initPackageDB verbosity conf dbPath + case compilerFlavor comp of HaskellSuite {} -> HaskellSuite.initPackageDB verbosity conf dbPath - _ -> die "Distribution.Simple.Register.initPackageDB: \ - \not implemented for this compiler" + _ -> withHcPkg "Distribution.Simple.Register.initPackageDB: \ + \not implemented for this compiler" comp conf + (\hpi -> HcPkg.init hpi verbosity dbPath) -- | Run @hc-pkg@ using a given package DB stack, directly forwarding the -- provided command-line arguments to it. invokeHcPkg :: Verbosity -> Compiler -> ProgramConfiguration -> PackageDBStack -> [String] -> IO () invokeHcPkg verbosity comp conf dbStack extraArgs = - case (compilerFlavor comp) of - GHC -> GHC.invokeHcPkg verbosity conf dbStack extraArgs - _ -> die "Distribution.Simple.Register.invokeHcPkg: \ - \not implemented for this compiler" + withHcPkg "invokeHcPkg" comp conf + (\hpi -> HcPkg.invoke hpi verbosity dbStack extraArgs) +withHcPkg :: String -> Compiler -> ProgramConfiguration + -> (HcPkgInfo -> IO a) -> IO a +withHcPkg name comp conf f = + case compilerFlavor comp of + GHC -> f (GHC.hcPkgInfo conf) + GHCJS -> f (GHCJS.hcPkgInfo conf) + LHC -> f (LHC.hcPkgInfo conf) + _ -> die ("Distribution.Simple.Register." ++ name ++ ":\ + \not implemented for this compiler") + registerPackage :: Verbosity -> InstalledPackageInfo -> PackageDescription @@ -212,26 +250,24 @@ else "Registering" setupMessage verbosity msg (packageId pkg) case compilerFlavor (compiler lbi) of - GHC -> GHC.registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs - LHC -> LHC.registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs - Hugs -> Hugs.registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs - UHC -> UHC.registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs - JHC -> notice verbosity "Registering for jhc (nothing to do)" - NHC -> notice verbosity "Registering for nhc98 (nothing to do)" + GHC -> GHC.registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs + GHCJS -> GHCJS.registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs + LHC -> LHC.registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs + UHC -> UHC.registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs + JHC -> notice verbosity "Registering for jhc (nothing to do)" HaskellSuite {} -> HaskellSuite.registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs _ -> die "Registering is not implemented for this compiler" - writeHcPkgRegisterScript :: Verbosity -> InstalledPackageInfo - -> ConfiguredProgram -> PackageDBStack + -> HcPkgInfo -> IO () -writeHcPkgRegisterScript verbosity installedPkgInfo hcPkg packageDbs = do - let invocation = HcPkg.reregisterInvocation hcPkg Verbosity.normal +writeHcPkgRegisterScript verbosity installedPkgInfo packageDbs hpi = do + let invocation = HcPkg.reregisterInvocation hpi Verbosity.normal packageDbs (Right installedPkgInfo) - regScript = invocationAsSystemScript buildOS invocation + regScript = invocationAsSystemScript buildOS invocation notice verbosity ("Creating package registration script: " ++ regScriptFileName) writeUTF8File regScriptFileName regScript @@ -253,15 +289,17 @@ :: ([FilePath] -> [FilePath]) -- ^ Translate relative include dir paths to -- absolute paths. -> PackageDescription + -> InstalledPackageId -> Library + -> LocalBuildInfo -> ComponentLocalBuildInfo -> InstallDirs FilePath -> InstalledPackageInfo -generalInstalledPackageInfo adjustRelIncDirs pkg lib clbi installDirs = +generalInstalledPackageInfo adjustRelIncDirs pkg ipid lib lbi clbi installDirs = InstalledPackageInfo { - --TODO: do not open-code this conversion from PackageId to InstalledPackageId - IPI.installedPackageId = InstalledPackageId (display (packageId pkg)), + IPI.installedPackageId = ipid, IPI.sourcePackageId = packageId pkg, + IPI.packageKey = pkgKey lbi, IPI.license = license pkg, IPI.copyright = copyright pkg, IPI.maintainer = maintainer pkg, @@ -273,22 +311,27 @@ IPI.description = description pkg, IPI.category = category pkg, IPI.exposed = libExposed lib, - IPI.exposedModules = exposedModules lib, + IPI.exposedModules = map fixupSelf (componentExposedModules clbi), IPI.hiddenModules = otherModules bi, + IPI.instantiatedWith = map (\(k,(p,n)) -> + (k,IPI.OriginalModule (IPI.installedPackageId p) n)) + (instantiatedWith lbi), IPI.trusted = IPI.trusted IPI.emptyInstalledPackageInfo, IPI.importDirs = [ libdir installDirs | hasModules ], + -- Note. the libsubdir and datasubdir templates have already been expanded + -- into libdir and datadir. IPI.libraryDirs = if hasLibrary then libdir installDirs : extraLibDirs bi else extraLibDirs bi, + IPI.dataDir = datadir installDirs, IPI.hsLibraries = [ libname | LibraryName libname <- componentLibraries clbi , hasLibrary ], IPI.extraLibraries = extraLibs bi, - IPI.extraGHCiLibraries = [], + IPI.extraGHCiLibraries = extraGHCiLibs bi, IPI.includeDirs = absinc ++ adjustRelIncDirs relinc, IPI.includes = includes bi, IPI.depends = map fst (componentPackageDeps clbi), - IPI.hugsOptions = hcOptions Hugs bi, IPI.ccOptions = [], -- Note. NOT ccOptions bi! -- We don't want cc-options to be propagated -- to C compilations in other packages. @@ -296,15 +339,28 @@ IPI.frameworkDirs = [], IPI.frameworks = frameworks bi, IPI.haddockInterfaces = [haddockdir installDirs haddockName pkg], - IPI.haddockHTMLs = [htmldir installDirs] + IPI.haddockHTMLs = [htmldir installDirs], + IPI.pkgRoot = Nothing } where bi = libBuildInfo lib (absinc, relinc) = partition isAbsolute (includeDirs bi) - hasModules = not $ null (exposedModules lib) - && null (otherModules bi) + hasModules = not $ null (libModules lib) hasLibrary = hasModules || not (null (cSources bi)) + || (not (null (jsSources bi)) && + compilerFlavor (compiler lbi) == GHCJS) + -- Since we currently don't decide the InstalledPackageId of our package + -- until just before we register, we didn't have one for the re-exports + -- of modules defined within this package, so we used an empty one that + -- we fill in here now that we know what it is. It's a bit of a hack, + -- we ought really to decide the InstalledPackageId ahead of time. + fixupSelf (IPI.ExposedModule n o o') = + IPI.ExposedModule n (fmap fixupOriginalModule o) + (fmap fixupOriginalModule o') + fixupOriginalModule (IPI.OriginalModule i m) = IPI.OriginalModule (fixupIpid i) m + fixupIpid (InstalledPackageId []) = ipid + fixupIpid x = x -- | Construct 'InstalledPackageInfo' for a library that is in place in the -- build tree. @@ -314,20 +370,20 @@ inplaceInstalledPackageInfo :: FilePath -- ^ top of the build tree -> FilePath -- ^ location of the dist tree -> PackageDescription + -> InstalledPackageId -> Library -> LocalBuildInfo -> ComponentLocalBuildInfo -> InstalledPackageInfo -inplaceInstalledPackageInfo inplaceDir distPref pkg lib lbi clbi = - generalInstalledPackageInfo adjustRelativeIncludeDirs pkg lib clbi - installDirs +inplaceInstalledPackageInfo inplaceDir distPref pkg ipid lib lbi clbi = + generalInstalledPackageInfo adjustRelativeIncludeDirs + pkg ipid lib lbi clbi installDirs where adjustRelativeIncludeDirs = map (inplaceDir ) installDirs = (absoluteInstallDirs pkg lbi NoCopyDest) { libdir = inplaceDir buildDir lbi, - datadir = inplaceDir, - datasubdir = distPref, + datadir = inplaceDir dataDir pkg, docdir = inplaceDocdir, htmldir = inplaceHtmldir, haddockdir = inplaceHtmldir @@ -342,12 +398,14 @@ -- This function knows about the layout of installed packages. -- absoluteInstalledPackageInfo :: PackageDescription + -> InstalledPackageId -> Library -> LocalBuildInfo -> ComponentLocalBuildInfo -> InstalledPackageInfo -absoluteInstalledPackageInfo pkg lib lbi clbi = - generalInstalledPackageInfo adjustReativeIncludeDirs pkg lib clbi installDirs +absoluteInstalledPackageInfo pkg ipid lib lbi clbi = + generalInstalledPackageInfo adjustReativeIncludeDirs + pkg ipid lib lbi clbi installDirs where -- For installed packages we install all include files into one dir, -- whereas in the build tree they may live in multiple local dirs. @@ -357,6 +415,28 @@ bi = libBuildInfo lib installDirs = absoluteInstallDirs pkg lbi NoCopyDest + +relocatableInstalledPackageInfo :: PackageDescription + -> InstalledPackageId + -> Library + -> LocalBuildInfo + -> ComponentLocalBuildInfo + -> FilePath + -> InstalledPackageInfo +relocatableInstalledPackageInfo pkg ipid lib lbi clbi pkgroot = + generalInstalledPackageInfo adjustReativeIncludeDirs + pkg ipid lib lbi clbi installDirs + where + -- For installed packages we install all include files into one dir, + -- whereas in the build tree they may live in multiple local dirs. + adjustReativeIncludeDirs _ + | null (installIncludes bi) = [] + | otherwise = [includedir installDirs] + bi = libBuildInfo lib + + installDirs = fmap (("${pkgroot}" ) . shortRelativePath pkgroot) + $ absoluteInstallDirs pkg lbi NoCopyDest + -- ----------------------------------------------------------------------------- -- Unregistration @@ -367,25 +447,16 @@ verbosity = fromFlag (regVerbosity regFlags) packageDb = fromFlagOrDefault (registrationPackageDB (withPackageDB lbi)) (regPackageDB regFlags) - installDirs = absoluteInstallDirs pkg lbi NoCopyDest + unreg hpi = + let invocation = HcPkg.unregisterInvocation + hpi Verbosity.normal packageDb pkgid + in if genScript + then writeFileAtomic unregScriptFileName + (BS.Char8.pack $ invocationAsSystemScript buildOS invocation) + else runProgramInvocation verbosity invocation setupMessage verbosity "Unregistering" pkgid - case compilerFlavor (compiler lbi) of - GHC -> - let Just ghcPkg = lookupProgram ghcPkgProgram (withPrograms lbi) - invocation = HcPkg.unregisterInvocation ghcPkg Verbosity.normal - packageDb pkgid - in if genScript - then writeFileAtomic unregScriptFileName - (BS.Char8.pack $ invocationAsSystemScript buildOS invocation) - else runProgramInvocation verbosity invocation - Hugs -> do - _ <- tryIO $ removeDirectoryRecursive (libdir installDirs) - return () - NHC -> do - _ <- tryIO $ removeDirectoryRecursive (libdir installDirs) - return () - _ -> - die ("only unregistering with GHC and Hugs is implemented") + withHcPkg "unregistering is only implemented for GHC and GHCJS" + (compiler lbi) (withPrograms lbi) unreg unregScriptFileName :: FilePath unregScriptFileName = case buildOS of diff --git a/Distribution/Simple/Setup.hs b/Distribution/Simple/Setup.hs --- a/Distribution/Simple/Setup.hs +++ b/Distribution/Simple/Setup.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.Simple.Setup @@ -70,6 +72,7 @@ ( Text(..), display ) import qualified Distribution.Compat.ReadP as Parse import qualified Text.PrettyPrint as Disp +import Distribution.ModuleName import Distribution.Package ( Dependency(..) , PackageName , InstalledPackageId ) @@ -79,10 +82,11 @@ import qualified Distribution.Simple.Command as Command import Distribution.Simple.Compiler ( CompilerFlavor(..), defaultCompilerFlavor, PackageDB(..) + , DebugInfoLevel(..), flagToDebugInfoLevel , OptimisationLevel(..), flagToOptimisationLevel , absolutePackageDBPath ) import Distribution.Simple.Utils - ( wrapLine, lowercase, intercalate ) + ( wrapText, wrapLine, lowercase, intercalate ) import Distribution.Simple.Program (Program(..), ProgramConfiguration, requireProgram, programInvocation, progInvokePath, progInvokeArgs, @@ -93,11 +97,14 @@ ( InstallDirs(..), CopyDest(..), PathTemplate, toPathTemplate, fromPathTemplate ) import Distribution.Verbosity +import Distribution.Utils.NubList import Control.Monad (liftM) +import Data.Binary (Binary) import Data.List ( sort ) import Data.Char ( isSpace, isAlpha ) import Data.Monoid ( Monoid(..) ) +import GHC.Generics (Generic) -- FIXME Not sure where this should live defaultDistPref :: FilePath @@ -124,8 +131,10 @@ -- Its monoid instance gives us the behaviour where it starts out as -- 'NoFlag' and later flags override earlier ones. -- -data Flag a = Flag a | NoFlag deriving (Show, Read, Eq) +data Flag a = Flag a | NoFlag deriving (Eq, Generic, Show, Read) +instance Binary a => Binary (Flag a) + instance Functor Flag where fmap f (Flag x) = Flag (f x) fmap _ NoFlag = NoFlag @@ -197,21 +206,34 @@ globalNumericVersion = Flag False } -globalCommand :: CommandUI GlobalFlags -globalCommand = CommandUI { - commandName = "", - commandSynopsis = "", - commandUsage = \_ -> +globalCommand :: [Command action] -> CommandUI GlobalFlags +globalCommand commands = CommandUI + { commandName = "" + , commandSynopsis = "" + , commandUsage = \pname -> "This Setup program uses the Haskell Cabal Infrastructure.\n" - ++ "See http://www.haskell.org/cabal/ for more information.\n", - commandDescription = Just $ \pname -> - "For more information about a command use\n" + ++ "See http://www.haskell.org/cabal/ for more information.\n" + ++ "\n" + ++ "Usage: " ++ pname ++ " [GLOBAL FLAGS] [COMMAND [FLAGS]]\n" + , commandDescription = Just $ \pname -> + let + commands' = commands ++ [commandAddAction helpCommandUI undefined] + cmdDescs = getNormalCommandDescriptions commands' + maxlen = maximum $ [length name | (name, _) <- cmdDescs] + align str = str ++ replicate (maxlen - length str) ' ' + in + "Commands:\n" + ++ unlines [ " " ++ align name ++ " " ++ description + | (name, description) <- cmdDescs ] + ++ "\n" + ++ "For more information about a command use\n" ++ " " ++ pname ++ " COMMAND --help\n\n" ++ "Typical steps for installing Cabal packages:\n" ++ concat [ " " ++ pname ++ " " ++ x ++ "\n" - | x <- ["configure", "build", "install"]], - commandDefaultFlags = defaultGlobalFlags, - commandOptions = \_ -> + | x <- ["configure", "build", "install"]] + , commandNotes = Nothing + , commandDefaultFlags = defaultGlobalFlags + , commandOptions = \_ -> [option ['V'] ["version"] "Print version information" globalVersion (\v flags -> flags { globalVersion = v }) @@ -252,10 +274,10 @@ configProgramPaths :: [(String, FilePath)], -- ^user specified programs paths configProgramArgs :: [(String, [String])], -- ^user specified programs args - configProgramPathExtra :: [FilePath], -- ^Extend the $PATH + configProgramPathExtra :: NubList FilePath, -- ^Extend the $PATH configHcFlavor :: Flag CompilerFlavor, -- ^The \"flavor\" of the -- compiler, such as GHC or - -- Hugs. + -- JHC. configHcPath :: Flag FilePath, -- ^given compiler location configHcPkg :: Flag FilePath, -- ^given hc-pkg location configVanillaLib :: Flag Bool, -- ^Enable vanilla library @@ -286,18 +308,25 @@ configConstraints :: [Dependency], -- ^Additional constraints for -- dependencies. configDependencies :: [(PackageName, InstalledPackageId)], + configInstantiateWith :: [(ModuleName, (InstalledPackageId, ModuleName))], -- ^The packages depended on. configConfigurationsFlags :: FlagAssignment, configTests :: Flag Bool, -- ^Enable test suite compilation configBenchmarks :: Flag Bool, -- ^Enable benchmark compilation - configLibCoverage :: Flag Bool, - -- ^Enable test suite program coverage. - configExactConfiguration :: Flag Bool + configCoverage :: Flag Bool, -- ^Enable program coverage + configLibCoverage :: Flag Bool, -- ^OBSOLETE. Just used to signal error. + configExactConfiguration :: Flag Bool, -- ^All direct dependencies and flags are provided on the command line by -- the user via the '--dependency' and '--flags' options. + configFlagError :: Flag String, + -- ^Halt and show an error message indicating an error in flag assignment + configRelocatable :: Flag Bool, -- ^ Enable relocatable package built + configDebugInfo :: Flag DebugInfoLevel -- ^ Emit debug info. } - deriving (Read,Show) + deriving (Generic, Read, Show) +instance Binary ConfigFlags + configAbsolutePaths :: ConfigFlags -> IO ConfigFlags configAbsolutePaths f = (\v -> f { configPackageDBs = v }) @@ -309,10 +338,10 @@ configPrograms = progConf, configHcFlavor = maybe NoFlag Flag defaultCompilerFlavor, configVanillaLib = Flag True, - configProfLib = Flag False, + configProfLib = NoFlag, configSharedLib = NoFlag, configDynExe = Flag False, - configProfExe = Flag False, + configProfExe = NoFlag, configOptimization = Flag NormalOptimisation, configProgPrefix = Flag (toPathTemplate ""), configProgSuffix = Flag (toPathTemplate ""), @@ -323,26 +352,36 @@ -- See #1589. configGHCiLib = Flag True, #else - configGHCiLib = Flag False, + configGHCiLib = NoFlag, #endif configSplitObjs = Flag False, -- takes longer, so turn off by default configStripExes = Flag True, configStripLibs = Flag True, configTests = Flag False, configBenchmarks = Flag False, - configLibCoverage = Flag False, - configExactConfiguration = Flag False + configCoverage = Flag False, + configLibCoverage = NoFlag, + configExactConfiguration = Flag False, + configFlagError = NoFlag, + configRelocatable = Flag False, + configDebugInfo = Flag NoDebugInfo } configureCommand :: ProgramConfiguration -> CommandUI ConfigFlags -configureCommand progConf = makeCommand name shortDesc - longDesc defaultFlags options - where - name = "configure" - shortDesc = "Prepare to build the package." - longDesc = Just (\_ -> programFlagsDescription progConf) - defaultFlags = defaultConfigFlags progConf - options showOrParseArgs = +configureCommand progConf = CommandUI + { commandName = "configure" + , commandSynopsis = "Prepare to build the package." + , commandDescription = Just $ \_ -> wrapText $ + "Configure how the package is built by setting " + ++ "package (and other) flags.\n" + ++ "\n" + ++ "The configuration affects several other commands, " + ++ "including build, test, bench, run, repl.\n" + , commandNotes = Just (\_ -> programFlagsDescription progConf) + , commandUsage = \pname -> + "Usage: " ++ pname ++ " configure [FLAGS]\n" + , commandDefaultFlags = defaultConfigFlags progConf + , commandOptions = \showOrParseArgs -> configureOptions showOrParseArgs ++ programConfigurationPaths progConf showOrParseArgs configProgramPaths (\v fs -> fs { configProgramPaths = v }) @@ -350,6 +389,7 @@ configProgramArgs (\v fs -> fs { configProgramArgs = v }) ++ programConfigurationOptions progConf showOrParseArgs configProgramArgs (\v fs -> fs { configProgramArgs = v }) + } configureOptions :: ShowOrParseArgs -> [OptionField ConfigFlags] configureOptions showOrParseArgs = @@ -361,13 +401,11 @@ ,option [] ["compiler"] "compiler" configHcFlavor (\v flags -> flags { configHcFlavor = v }) - (choiceOpt [ (Flag GHC, ("g", ["ghc"]), "compile with GHC") - , (Flag NHC, ([] , ["nhc98"]), "compile with NHC") - , (Flag JHC, ([] , ["jhc"]), "compile with JHC") - , (Flag LHC, ([] , ["lhc"]), "compile with LHC") - , (Flag Hugs,([] , ["hugs"]), "compile with Hugs") - , (Flag UHC, ([] , ["uhc"]), "compile with UHC") - + (choiceOpt [ (Flag GHC, ("g", ["ghc"]), "compile with GHC") + , (Flag GHCJS, ([] , ["ghcjs"]), "compile with GHCJS") + , (Flag JHC, ([] , ["jhc"]), "compile with JHC") + , (Flag LHC, ([] , ["lhc"]), "compile with LHC") + , (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"]), @@ -384,13 +422,7 @@ (reqArgFlag "PATH") ] ++ map liftInstallDirs installDirsOptions - ++ [option "b" ["scratchdir"] - "directory to receive the built package (hugs-only)" - configScratchDir (\v flags -> flags { configScratchDir = v }) - (reqArgFlag "DIR") - --TODO: eliminate scratchdir flag - - ,option "" ["program-prefix"] + ++ [option "" ["program-prefix"] "prefix to be applied to installed executables" configProgPrefix (\v flags -> flags { configProgPrefix = v }) @@ -421,8 +453,8 @@ configDynExe (\v flags -> flags { configDynExe = v }) (boolOpt [] []) - ,option "" ["executable-profiling"] - "Executable profiling" + ,option "" ["profiling", "executable-profiling"] + "Executable profiling (requires library profiling)" configProfExe (\v flags -> flags { configProfExe = v }) (boolOpt [] []) @@ -441,6 +473,22 @@ "Build without optimization" ] + ,multiOption "debug-info" + configDebugInfo (\v flags -> flags { configDebugInfo = v }) + [optArg' "n" (Flag . flagToDebugInfoLevel) + (\f -> case f of + Flag NoDebugInfo -> [] + Flag MinimalDebugInfo -> [Just "1"] + Flag NormalDebugInfo -> [Nothing] + Flag MaximalDebugInfo -> [Just "3"] + _ -> []) + "" ["enable-debug-info"] + "Emit debug info (n is 0--3, default is 0)", + noArg (Flag NoDebugInfo) [] + ["disable-debug-info"] + "Don't emit debug info" + ] + ,option "" ["library-for-ghci"] "compile library for use with GHCi" configGHCiLib (\v flags -> flags { configGHCiLib = v }) @@ -494,7 +542,7 @@ ,option "" ["extra-prog-path"] "A list of directories to search for required programs (in addition to the normal search locations)" configProgramPathExtra (\v flags -> flags {configProgramPathExtra = v}) - (reqArg' "PATH" (\x -> [x]) id) + (reqArg' "PATH" (\x -> toNubList [x]) fromNubList) ,option "" ["constraint"] "A list of additional constraints on the dependencies." @@ -510,16 +558,28 @@ (readP_to_E (const "dependency expected") ((\x -> [x]) `fmap` parseDependency)) (map (\x -> display (fst x) ++ "=" ++ display (snd x)))) + ,option "" ["instantiate-with"] + "A mapping of signature names to concrete module instantiations. E.g., --instantiate-with=\"Map=Data.Map.Strict@containers-0.5.5.1-inplace\"" + configInstantiateWith (\v flags -> flags { configInstantiateWith = v }) + (reqArg "NAME=PKG:MOD" + (readP_to_E (const "signature mapping expected") ((\x -> [x]) `fmap` parseHoleMapEntry)) + (map (\(n,(p,m)) -> display n ++ "=" ++ display m ++ "@" ++ display p))) + ,option "" ["tests"] "dependency checking and compilation for test suites listed in the package description file." configTests (\v flags -> flags { configTests = v }) (boolOpt [] []) ,option "" ["library-coverage"] - "build library and test suites with Haskell Program Coverage enabled. (GHC only)" + "OBSOLETE. Please use --enable-coverage instead." configLibCoverage (\v flags -> flags { configLibCoverage = v }) (boolOpt [] []) + ,option "" ["coverage"] + "build package with Haskell Program Coverage enabled. (GHC only)" + configCoverage (\v flags -> flags { configCoverage = v }) + (boolOpt [] []) + ,option "" ["exact-configuration"] "All direct dependencies and flags are provided on the command line." configExactConfiguration @@ -530,6 +590,11 @@ "dependency checking and compilation for benchmarks listed in the package description file." configBenchmarks (\v flags -> flags { configBenchmarks = v }) (boolOpt [] []) + + ,option "" ["relocatable"] + "building a package that is relocatable. (GHC only)" + configRelocatable (\v flags -> flags { configRelocatable = v}) + (boolOpt [] []) ] where readFlagList :: String -> FlagAssignment @@ -570,6 +635,15 @@ y <- parse return (x, y) +parseHoleMapEntry :: Parse.ReadP r (ModuleName, (InstalledPackageId, ModuleName)) +parseHoleMapEntry = do + x <- parse + _ <- Parse.char '=' + y <- parse + _ <- Parse.char '@' + z <- parse + return (x, (z, y)) + installDirsOptions :: [OptionField (InstallDirs (Flag PathTemplate))] installDirsOptions = [ option "" ["prefix"] @@ -666,12 +740,17 @@ configExtraLibDirs = mempty, configConstraints = mempty, configDependencies = mempty, + configInstantiateWith = mempty, configExtraIncludeDirs = mempty, configConfigurationsFlags = mempty, configTests = mempty, - configLibCoverage = mempty, + configCoverage = mempty, + configLibCoverage = mempty, configExactConfiguration = mempty, - configBenchmarks = mempty + configBenchmarks = mempty, + configFlagError = mempty, + configRelocatable = mempty, + configDebugInfo = mempty } mappend a b = ConfigFlags { configPrograms = configPrograms b, @@ -703,12 +782,17 @@ configExtraLibDirs = combine configExtraLibDirs, configConstraints = combine configConstraints, configDependencies = combine configDependencies, + configInstantiateWith = combine configInstantiateWith, configExtraIncludeDirs = combine configExtraIncludeDirs, configConfigurationsFlags = combine configConfigurationsFlags, configTests = combine configTests, + configCoverage = combine configCoverage, configLibCoverage = combine configLibCoverage, configExactConfiguration = combine configExactConfiguration, - configBenchmarks = combine configBenchmarks + configBenchmarks = combine configBenchmarks, + configFlagError = combine configFlagError, + configRelocatable = combine configRelocatable, + configDebugInfo = combine configDebugInfo } where combine field = field a `mappend` field b @@ -732,14 +816,17 @@ } copyCommand :: CommandUI CopyFlags -copyCommand = makeCommand name shortDesc longDesc defaultCopyFlags options - where - name = "copy" - shortDesc = "Copy the files into the install locations." - longDesc = Just $ \_ -> - "Does not call register, and allows a prefix at install time\n" +copyCommand = CommandUI + { commandName = "copy" + , commandSynopsis = "Copy the files into the install locations." + , commandDescription = Just $ \_ -> wrapText $ + "Does not call register, and allows a prefix at install time. " ++ "Without the --destdir flag, configure determines location.\n" - options showOrParseArgs = + , commandNotes = Nothing + , commandUsage = \pname -> + "Usage: " ++ pname ++ " copy [FLAGS]\n" + , commandDefaultFlags = defaultCopyFlags + , commandOptions = \showOrParseArgs -> [optionVerbosity copyVerbosity (\v flags -> flags { copyVerbosity = v }) ,optionDistPref @@ -752,6 +839,7 @@ (reqArg "DIR" (succeedReadE (Flag . CopyTo)) (\f -> case f of Flag (CopyTo p) -> [p]; _ -> [])) ] + } emptyCopyFlags :: CopyFlags emptyCopyFlags = mempty @@ -793,15 +881,19 @@ } installCommand :: CommandUI InstallFlags -installCommand = makeCommand name shortDesc longDesc defaultInstallFlags options - where - name = "install" - shortDesc = "Copy the files into the install locations. Run register." - longDesc = Just $ \_ -> - "Unlike the copy command, install calls the register command.\n" - ++ "If you want to install into a location that is not what was\n" +installCommand = CommandUI + { commandName = "install" + , commandSynopsis = + "Copy the files into the install locations. Run register." + , commandDescription = Just $ \_ -> wrapText $ + "Unlike the copy command, install calls the register command." + ++ "If you want to install into a location that is not what was" ++ "specified in the configure step, use the copy command.\n" - options showOrParseArgs = + , commandNotes = Nothing + , commandUsage = \pname -> + "Usage: " ++ pname ++ " install [FLAGS]\n" + , commandDefaultFlags = defaultInstallFlags + , commandOptions = \showOrParseArgs -> [optionVerbosity installVerbosity (\v flags -> flags { installVerbosity = v }) ,optionDistPref installDistPref (\d flags -> flags { installDistPref = d }) @@ -824,6 +916,7 @@ , (Flag GlobalPackageDB, ([],["global"]), "(default) upon configuration register this package in the system-wide package database")]) ] + } emptyInstallFlags :: InstallFlags emptyInstallFlags = mempty @@ -869,18 +962,22 @@ } sdistCommand :: CommandUI SDistFlags -sdistCommand = makeCommand name shortDesc longDesc defaultSDistFlags options - where - name = "sdist" - shortDesc = "Generate a source distribution file (.tar.gz)." - longDesc = Nothing - options showOrParseArgs = +sdistCommand = CommandUI + { commandName = "sdist" + , commandSynopsis = + "Generate a source distribution file (.tar.gz)." + , commandDescription = Nothing + , commandNotes = Nothing + , commandUsage = \pname -> + "Usage: " ++ pname ++ " sdist [FLAGS]\n" + , commandDefaultFlags = defaultSDistFlags + , commandOptions = \showOrParseArgs -> [optionVerbosity sDistVerbosity (\v flags -> flags { sDistVerbosity = v }) ,optionDistPref sDistDistPref (\d flags -> flags { sDistDistPref = d }) showOrParseArgs - ,option "" ["list-sources"] + ,option "" ["list-sources"] "Just write a list of the package's sources to a file" sDistListSources (\v flags -> flags { sDistListSources = v }) (reqArgFlag "FILE") @@ -896,6 +993,7 @@ sDistDirectory (\v flags -> flags { sDistDirectory = v }) (reqArgFlag "DIR") ] + } emptySDistFlags :: SDistFlags emptySDistFlags = mempty @@ -929,6 +1027,7 @@ regGenPkgConf :: Flag (Maybe FilePath), regInPlace :: Flag Bool, regDistPref :: Flag FilePath, + regPrintId :: Flag Bool, regVerbosity :: Flag Verbosity } deriving Show @@ -940,17 +1039,21 @@ regGenPkgConf = NoFlag, regInPlace = Flag False, regDistPref = Flag defaultDistPref, + regPrintId = Flag False, regVerbosity = Flag normal } registerCommand :: CommandUI RegisterFlags -registerCommand = makeCommand name shortDesc longDesc - defaultRegisterFlags options - where - name = "register" - shortDesc = "Register this package with the compiler." - longDesc = Nothing - options showOrParseArgs = +registerCommand = CommandUI + { commandName = "register" + , commandSynopsis = + "Register this package with the compiler." + , commandDescription = Nothing + , commandNotes = Nothing + , commandUsage = \pname -> + "Usage: " ++ pname ++ " register [FLAGS]\n" + , commandDefaultFlags = defaultRegisterFlags + , commandOptions = \showOrParseArgs -> [optionVerbosity regVerbosity (\v flags -> flags { regVerbosity = v }) ,optionDistPref regDistPref (\d flags -> flags { regDistPref = d }) @@ -977,16 +1080,25 @@ "instead of registering, generate a package registration file" regGenPkgConf (\v flags -> flags { regGenPkgConf = v }) (optArg' "PKG" Flag flagToList) + + ,option "" ["print-ipid"] + "print the installed package ID calculated for this package" + regPrintId (\v flags -> flags { regPrintId = v }) + trueArg ] + } unregisterCommand :: CommandUI RegisterFlags -unregisterCommand = makeCommand name shortDesc - longDesc defaultRegisterFlags options - where - name = "unregister" - shortDesc = "Unregister this package with the compiler." - longDesc = Nothing - options showOrParseArgs = +unregisterCommand = CommandUI + { commandName = "unregister" + , commandSynopsis = + "Unregister this package with the compiler." + , commandDescription = Nothing + , commandNotes = Nothing + , commandUsage = \pname -> + "Usage: " ++ pname ++ " unregister [FLAGS]\n" + , commandDefaultFlags = defaultRegisterFlags + , commandOptions = \showOrParseArgs -> [optionVerbosity regVerbosity (\v flags -> flags { regVerbosity = v }) ,optionDistPref regDistPref (\d flags -> flags { regDistPref = d }) @@ -1004,6 +1116,7 @@ regGenScript (\v flags -> flags { regGenScript = v }) trueArg ] + } emptyRegisterFlags :: RegisterFlags emptyRegisterFlags = mempty @@ -1014,6 +1127,7 @@ regGenScript = mempty, regGenPkgConf = mempty, regInPlace = mempty, + regPrintId = mempty, regDistPref = mempty, regVerbosity = mempty } @@ -1022,6 +1136,7 @@ regGenScript = combine regGenScript, regGenPkgConf = combine regGenPkgConf, regInPlace = combine regInPlace, + regPrintId = combine regPrintId, regDistPref = combine regDistPref, regVerbosity = combine regVerbosity } @@ -1074,13 +1189,16 @@ where combine field = field a `mappend` field b hscolourCommand :: CommandUI HscolourFlags -hscolourCommand = makeCommand name shortDesc longDesc - defaultHscolourFlags options - where - name = "hscolour" - shortDesc = "Generate HsColour colourised code, in HTML format." - longDesc = Just (\_ -> "Requires hscolour.\n") - options showOrParseArgs = +hscolourCommand = CommandUI + { commandName = "hscolour" + , commandSynopsis = + "Generate HsColour colourised code, in HTML format." + , commandDescription = Just (\_ -> "Requires the hscolour program.\n") + , commandNotes = Nothing + , commandUsage = \pname -> + "Usage: " ++ pname ++ " hscolour [FLAGS]\n" + , commandDefaultFlags = defaultHscolourFlags + , commandOptions = \showOrParseArgs -> [optionVerbosity hscolourVerbosity (\v flags -> flags { hscolourVerbosity = v }) ,optionDistPref @@ -1117,6 +1235,7 @@ hscolourCSS (\v flags -> flags { hscolourCSS = v }) (reqArgFlag "PATH") ] + } -- ------------------------------------------------------------ -- * Haddock flags @@ -1163,18 +1282,25 @@ } haddockCommand :: CommandUI HaddockFlags -haddockCommand = makeCommand name shortDesc longDesc defaultHaddockFlags options - where - name = "haddock" - shortDesc = "Generate Haddock HTML documentation." - longDesc = Just $ \_ -> "Requires the program haddock, version 2.x.\n" - options showOrParseArgs = haddockOptions showOrParseArgs +haddockCommand = CommandUI + { commandName = "haddock" + , commandSynopsis = "Generate Haddock HTML documentation." + , commandDescription = Just $ \_ -> + "Requires the program haddock, version 2.x.\n" + , commandNotes = Nothing + , commandUsage = \pname -> + "Usage: " ++ pname ++ " haddock [FLAGS]\n" + , commandDefaultFlags = defaultHaddockFlags + , commandOptions = \showOrParseArgs -> + haddockOptions showOrParseArgs ++ programConfigurationPaths progConf ParseArgs haddockProgramPaths (\v flags -> flags { haddockProgramPaths = v}) ++ programConfigurationOption progConf showOrParseArgs haddockProgramArgs (\v fs -> fs { haddockProgramArgs = v }) ++ programConfigurationOptions progConf ParseArgs haddockProgramArgs (\v flags -> flags { haddockProgramArgs = v}) + } + where progConf = addKnownProgram haddockProgram $ addKnownProgram ghcProgram $ emptyProgramConfiguration @@ -1321,12 +1447,16 @@ } cleanCommand :: CommandUI CleanFlags -cleanCommand = makeCommand name shortDesc longDesc defaultCleanFlags options - where - name = "clean" - shortDesc = "Clean up after a build." - longDesc = Just (\_ -> "Removes .hi, .o, preprocessed sources, etc.\n") - options showOrParseArgs = +cleanCommand = CommandUI + { commandName = "clean" + , commandSynopsis = "Clean up after a build." + , commandDescription = Just $ \_ -> + "Removes .hi, .o, preprocessed sources, etc.\n" + , commandNotes = Nothing + , commandUsage = \pname -> + "Usage: " ++ pname ++ " clean [FLAGS]\n" + , commandDefaultFlags = defaultCleanFlags + , commandOptions = \showOrParseArgs -> [optionVerbosity cleanVerbosity (\v flags -> flags { cleanVerbosity = v }) ,optionDistPref cleanDistPref (\d flags -> flags { cleanDistPref = d }) @@ -1337,6 +1467,7 @@ cleanSaveConf (\v flags -> flags { cleanSaveConf = v }) trueArg ] + } emptyCleanFlags :: CleanFlags emptyCleanFlags = mempty @@ -1385,21 +1516,14 @@ } buildCommand :: ProgramConfiguration -> CommandUI BuildFlags -buildCommand progConf = - makeCommand name shortDesc longDesc - defaultBuildFlags - (\showOrParseArgs -> - [ optionVerbosity - buildVerbosity (\v flags -> flags { buildVerbosity = v }) - - , optionDistPref - buildDistPref (\d flags -> flags { buildDistPref = d }) showOrParseArgs - ] - ++ buildOptions progConf showOrParseArgs) - where - name = "build" - shortDesc = "Compile all targets or specific targets." - longDesc = Just $ \pname -> +buildCommand progConf = CommandUI + { commandName = "build" + , commandSynopsis = "Compile all/specific components." + , commandDescription = Just $ \_ -> wrapText $ + "Components encompass executables, tests, and benchmarks.\n" + ++ "\n" + ++ "Affected by configuration options, see `configure`.\n" + , commandNotes = Just $ \pname -> "Examples:\n" ++ " " ++ pname ++ " build " ++ " All the components in the package\n" @@ -1415,7 +1539,21 @@ -- ++ "name, e.g.\n" -- ++ " " ++ pname ++ " build foo:Foo.Bar\n" -- ++ " " ++ pname ++ " build testsuite1:Foo/Bar.hs\n" + , commandUsage = usageAlternatives "build" $ + [ "[FLAGS]" + , "COMPONENTS [FLAGS]" + ] + , commandDefaultFlags = defaultBuildFlags + , commandOptions = \showOrParseArgs -> + [ optionVerbosity + buildVerbosity (\v flags -> flags { buildVerbosity = v }) + , optionDistPref + buildDistPref (\d flags -> flags { buildDistPref = d }) showOrParseArgs + ] + ++ buildOptions progConf showOrParseArgs + } + buildOptions :: ProgramConfiguration -> ShowOrParseArgs -> [OptionField BuildFlags] buildOptions progConf showOrParseArgs = @@ -1494,15 +1632,37 @@ where combine field = field a `mappend` field b replCommand :: ProgramConfiguration -> CommandUI ReplFlags -replCommand progConf = CommandUI { - commandName = "repl", - commandSynopsis = "Open an interpreter session for the given target.", - commandDescription = Just $ \pname -> - "Examples:\n" - ++ " " ++ pname ++ " repl " - ++ " The first component in the package\n" - ++ " " ++ pname ++ " repl foo " - ++ " A named component (i.e. lib, exe, test suite)\n", +replCommand progConf = CommandUI + { commandName = "repl" + , commandSynopsis = + "Open an interpreter session for the given component." + , commandDescription = Just $ \pname -> wrapText $ + "If the current directory contains no package, ignores COMPONENT " + ++ "parameters and opens an interactive interpreter session; if a " + ++ "sandbox is present, its package database will be used.\n" + ++ "\n" + ++ "Otherwise, (re)configures with the given or default flags, and " + ++ "loads the interpreter with the relevant modules. For executables, " + ++ "tests and benchmarks, loads the main module (and its " + ++ "dependencies); for libraries all exposed/other modules.\n" + ++ "\n" + ++ "The default component is the library itself, or the executable " + ++ "if that is the only component.\n" + ++ "\n" + ++ "Support for loading specific modules is planned but not " + ++ "implemented yet. For certain scenarios, `" ++ pname + ++ " exec -- ghci :l Foo` may be used instead. Note that `exec` will " + ++ "not (re)configure and you will have to specify the location of " + ++ "other modules, if required.\n" + + , commandNotes = Just $ \pname -> + "Examples:\n" + ++ " " ++ pname ++ " repl " + ++ " The first component in the package\n" + ++ " " ++ pname ++ " repl foo " + ++ " A named component (i.e. lib, exe, test suite)\n" + ++ " " ++ pname ++ " repl --ghc-options=\"-lstdc++\"" + ++ " Specifying flags for interpreter\n" --TODO: re-enable once we have support for module/file targets -- ++ " " ++ pname ++ " repl Foo.Bar " -- ++ " A module\n" @@ -1512,10 +1672,9 @@ -- ++ "name, e.g.\n" -- ++ " " ++ pname ++ " repl foo:Foo.Bar\n" -- ++ " " ++ pname ++ " repl testsuite1:Foo/Bar.hs\n" - - commandUsage = \pname -> "Usage: " ++ pname ++ " repl [FILENAME] [FLAGS]\n", - commandDefaultFlags = defaultReplFlags, - commandOptions = \showOrParseArgs -> + , commandUsage = \pname -> "Usage: " ++ pname ++ " repl [COMPONENT] [FLAGS]\n" + , commandDefaultFlags = defaultReplFlags + , commandOptions = \showOrParseArgs -> optionVerbosity replVerbosity (\v flags -> flags { replVerbosity = v }) : optionDistPref replDistPref (\d flags -> flags { replDistPref = d }) @@ -1538,7 +1697,7 @@ trueArg ] _ -> [] - } + } -- ------------------------------------------------------------ -- * Test flags @@ -1573,9 +1732,6 @@ testMachineLog :: Flag PathTemplate, testShowDetails :: Flag TestShowDetails, testKeepTix :: Flag Bool, - --TODO: eliminate the test list and pass it directly as positional args to - --the testHook - testList :: Flag [String], -- TODO: think about if/how options are passed to test exes testOptions :: [PathTemplate] } @@ -1588,17 +1744,31 @@ testMachineLog = toFlag $ toPathTemplate $ "$pkgid.log", testShowDetails = toFlag Failures, testKeepTix = toFlag False, - testList = Flag [], testOptions = [] } testCommand :: CommandUI TestFlags -testCommand = makeCommand name shortDesc longDesc defaultTestFlags options - where - name = "test" - shortDesc = "Run the test suite, if any (configure with UserHooks)." - longDesc = Nothing - options showOrParseArgs = +testCommand = CommandUI + { commandName = "test" + , commandSynopsis = + "Run all/specific tests in the test suite." + , commandDescription = Just $ \pname -> wrapText $ + "If necessary (re)configures with `--enable-tests` flag and builds" + ++ " the test suite.\n" + ++ "\n" + ++ "Remember that the tests' dependencies must be installed if there" + ++ " are additional ones; e.g. with `" ++ pname + ++ " install --only-dependencies --enable-tests`.\n" + ++ "\n" + ++ "By defining UserHooks in a custom Setup.hs, the package can" + ++ " define actions to be executed before and after running tests.\n" + , commandNotes = Nothing + , commandUsage = usageAlternatives "test" + [ "[FLAGS]" + , "TESTCOMPONENTS [FLAGS]" + ] + , commandDefaultFlags = defaultTestFlags + , commandOptions = \showOrParseArgs -> [ optionVerbosity testVerbosity (\v flags -> flags { testVerbosity = v }) , optionDistPref testDistPref (\d flags -> flags { testDistPref = d }) @@ -1620,7 +1790,8 @@ , option [] ["show-details"] ("'always': always show results of individual test cases. " ++ "'never': never show results of individual test cases. " - ++ "'failures': show results of failing test cases.") + ++ "'failures': show results of failing test cases. " + ++ "'streaming': show results of test cases in real time.") testShowDetails (\v flags -> flags { testShowDetails = v }) (reqArg "FILTER" (readP_to_E (\_ -> "--show-details flag expects one of " @@ -1648,6 +1819,7 @@ (reqArg' "TEMPLATE" (\x -> [toPathTemplate x]) (map fromPathTemplate)) ] + } emptyTestFlags :: TestFlags emptyTestFlags = mempty @@ -1660,7 +1832,6 @@ testMachineLog = mempty, testShowDetails = mempty, testKeepTix = mempty, - testList = mempty, testOptions = mempty } mappend a b = TestFlags { @@ -1670,7 +1841,6 @@ testMachineLog = combine testMachineLog, testShowDetails = combine testShowDetails, testKeepTix = combine testKeepTix, - testList = combine testList, testOptions = combine testOptions } where combine field = field a `mappend` field b @@ -1693,13 +1863,28 @@ } benchmarkCommand :: CommandUI BenchmarkFlags -benchmarkCommand = makeCommand name shortDesc - longDesc defaultBenchmarkFlags options - where - name = "bench" - shortDesc = "Run the benchmark, if any (configure with UserHooks)." - longDesc = Nothing - options showOrParseArgs = +benchmarkCommand = CommandUI + { commandName = "bench" + , commandSynopsis = + "Run all/specific benchmarks." + , commandDescription = Just $ \pname -> wrapText $ + "If necessary (re)configures with `--enable-benchmarks` flag and" + ++ " builds the benchmarks.\n" + ++ "\n" + ++ "Remember that the benchmarks' dependencies must be installed if" + ++ " there are additional ones; e.g. with `" ++ pname + ++ " install --only-dependencies --enable-benchmarks`.\n" + ++ "\n" + ++ "By defining UserHooks in a custom Setup.hs, the package can" + ++ " define actions to be executed before and after running" + ++ " benchmarks.\n" + , commandNotes = Nothing + , commandUsage = usageAlternatives "bench" + [ "[FLAGS]" + , "BENCHCOMPONENTS [FLAGS]" + ] + , commandDefaultFlags = defaultBenchmarkFlags + , commandOptions = \showOrParseArgs -> [ optionVerbosity benchmarkVerbosity (\v flags -> flags { benchmarkVerbosity = v }) , optionDistPref @@ -1721,6 +1906,7 @@ (reqArg' "TEMPLATE" (\x -> [toPathTemplate x]) (map fromPathTemplate)) ] + } emptyBenchmarkFlags :: BenchmarkFlags emptyBenchmarkFlags = mempty diff --git a/Distribution/Simple/SrcDist.hs b/Distribution/Simple/SrcDist.hs --- a/Distribution/Simple/SrcDist.hs +++ b/Distribution/Simple/SrcDist.hs @@ -66,13 +66,14 @@ ( LocalBuildInfo(..), withAllComponentsInBuildOrder ) import Distribution.Simple.BuildPaths ( autogenModuleName ) import Distribution.Simple.Program ( defaultProgramConfiguration, requireProgram, - rawSystemProgram, tarProgram ) + runProgram, programProperties, tarProgram ) import Distribution.Text ( display ) import Control.Monad(when, unless, forM) import Data.Char (toLower) import Data.List (partition, isPrefixOf) +import qualified Data.Map as Map import Data.Maybe (isNothing, catMaybes) import Data.Time (UTCTime, getCurrentTime, toGregorian, utctDay) import System.Directory ( doesFileExist ) @@ -411,13 +412,17 @@ (tarProg, _) <- requireProgram verbosity tarProgram (maybe defaultProgramConfiguration withPrograms mb_lbi) - - -- Hmm: I could well be skating on thinner ice here by using the -C option - -- (=> GNU tar-specific?) [The prev. solution used pipes and sub-command - -- sequences to set up the paths correctly, which is problematic in a Windows - -- setting.] - rawSystemProgram verbosity tarProg - ["-C", tmpDir, "-czf", tarBallFilePath, tarBallName pkg_descr] + let formatOptSupported = maybe False (== "YES") $ + Map.lookup "Supports --format" + (programProperties tarProg) + runProgram verbosity tarProg $ + -- Hmm: I could well be skating on thinner ice here by using the -C option + -- (=> seems to be supported at least by GNU and *BSD tar) [The + -- prev. solution used pipes and sub-command sequences to set up the paths + -- correctly, which is problematic in a Windows setting.] + ["-czf", tarBallFilePath, "-C", tmpDir] + ++ (if formatOptSupported then ["--format", "ustar"] else []) + ++ [tarBallName pkg_descr] return tarBallFilePath -- | Given a buildinfo, return the names of all source files. @@ -438,7 +443,7 @@ in findFileWithExtension fileExts (hsSourceDirs bi) file | module_ <- modules ++ otherModules bi ] - return $ sources ++ catMaybes bootFiles ++ cSources bi + return $ sources ++ catMaybes bootFiles ++ cSources bi ++ jsSources bi where suffixes = ppSuffixes pps ++ ["hs", "lhs"] diff --git a/Distribution/Simple/Test.hs b/Distribution/Simple/Test.hs --- a/Distribution/Simple/Test.hs +++ b/Distribution/Simple/Test.hs @@ -19,14 +19,15 @@ ( PackageDescription(..), BuildInfo(buildable) , TestSuite(..) , TestSuiteInterface(..), testType, hasTests ) -import Distribution.Simple.Compiler ( Compiler(..) ) +import Distribution.Simple.Compiler ( compilerInfo ) import Distribution.Simple.Hpc ( markupPackage ) import Distribution.Simple.InstallDirs ( fromPathTemplate, initialPathTemplateEnv, substPathTemplate , PathTemplate ) import qualified Distribution.Simple.LocalBuildInfo as LBI ( LocalBuildInfo(..) ) -import Distribution.Simple.Setup ( TestFlags(..), fromFlag ) +import Distribution.Simple.Setup ( TestFlags(..), fromFlag, configCoverage ) +import Distribution.Simple.UserHooks ( Args ) import qualified Distribution.Simple.Test.ExeV10 as ExeV10 import qualified Distribution.Simple.Test.LibV09 as LibV09 import Distribution.Simple.Test.Log @@ -42,16 +43,17 @@ import System.FilePath ( () ) -- |Perform the \"@.\/setup test@\" action. -test :: PD.PackageDescription -- ^information from the .cabal file +test :: Args -- ^positional command-line arguments + -> PD.PackageDescription -- ^information from the .cabal file -> LBI.LocalBuildInfo -- ^information from the configure step -> TestFlags -- ^flags sent to test -> IO () -test pkg_descr lbi flags = do +test args pkg_descr lbi flags = do let verbosity = fromFlag $ testVerbosity flags machineTemplate = fromFlag $ testMachineLog flags distPref = fromFlag $ testDistPref flags testLogDir = distPref "test" - testNames = fromFlag $ testList flags + testNames = args pkgTests = PD.testSuites pkg_descr enabledTests = [ t | t <- pkgTests , PD.testEnabled t @@ -115,8 +117,10 @@ allOk <- summarizePackage verbosity packageLog writeFile packageLogFile $ show packageLog - markupPackage verbosity lbi distPref (display $ PD.package pkg_descr) - $ map fst testsToRun + let isCoverageEnabled = fromFlag $ configCoverage $ LBI.configFlags lbi + when isCoverageEnabled $ + markupPackage verbosity lbi distPref (display $ PD.package pkg_descr) $ + map fst testsToRun unless allOk exitFailure @@ -128,5 +132,5 @@ fromPathTemplate $ substPathTemplate env template where env = initialPathTemplateEnv - (PD.package pkg_descr) (compilerId $ LBI.compiler lbi) - (LBI.hostPlatform lbi) + (PD.package pkg_descr) (LBI.pkgKey lbi) + (compilerInfo $ LBI.compiler lbi) (LBI.hostPlatform lbi) diff --git a/Distribution/Simple/Test/ExeV10.hs b/Distribution/Simple/Test/ExeV10.hs --- a/Distribution/Simple/Test/ExeV10.hs +++ b/Distribution/Simple/Test/ExeV10.hs @@ -7,15 +7,18 @@ import qualified Distribution.PackageDescription as PD import Distribution.Simple.Build.PathsModule ( pkgPathEnvVar ) import Distribution.Simple.BuildPaths ( exeExtension ) -import Distribution.Simple.Compiler ( Compiler(..) ) -import Distribution.Simple.Hpc ( markupTest, tixDir, tixFilePath ) +import Distribution.Simple.Compiler ( compilerInfo ) +import Distribution.Simple.Hpc ( guessWay, markupTest, tixDir, tixFilePath ) import Distribution.Simple.InstallDirs ( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..) , substPathTemplate , toPathTemplate, PathTemplate ) import qualified Distribution.Simple.LocalBuildInfo as LBI -import Distribution.Simple.Setup ( TestFlags(..), TestShowDetails(..), fromFlag ) +import Distribution.Simple.Setup + ( TestFlags(..), TestShowDetails(..), fromFlag, configCoverage ) import Distribution.Simple.Test.Log -import Distribution.Simple.Utils ( die, notice, rawSystemIOWithEnv ) +import Distribution.Simple.Utils + ( die, notice, rawSystemIOWithEnv, addLibraryPath ) +import Distribution.System ( Platform (..) ) import Distribution.TestSuite import Distribution.Text import Distribution.Verbosity ( normal ) @@ -35,6 +38,10 @@ -> PD.TestSuite -> IO TestSuiteLog runTest pkg_descr lbi flags suite = do + let isCoverageEnabled = fromFlag $ configCoverage $ LBI.configFlags lbi + way = guessWay lbi + tixDir_ = tixDir distPref way $ PD.testName suite + pwd <- getCurrentDirectory existingEnv <- getEnvironment @@ -47,12 +54,11 @@ -- Remove old .tix files if appropriate. unless (fromFlag $ testKeepTix flags) $ do - let tDir = tixDir distPref $ PD.testName suite - exists' <- doesDirectoryExist tDir - when exists' $ removeDirectoryRecursive tDir + exists' <- doesDirectoryExist tixDir_ + when exists' $ removeDirectoryRecursive tixDir_ -- Create directory for HPC files. - createDirectoryIfMissing True $ tixDir distPref $ PD.testName suite + createDirectoryIfMissing True tixDir_ -- Write summary notices indicating start of test suite notice verbosity $ summarizeSuiteStart $ PD.testName suite @@ -71,11 +77,21 @@ let opts = map (testOption pkg_descr lbi suite) (testOptions flags) dataDirPath = pwd PD.dataDir pkg_descr - tixFile = pwd (tixFilePath distPref $ PD.testName suite) - shellEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath) - : ("HPCTIXFILE", tixFile) + tixFile = pwd tixFilePath distPref way (PD.testName suite) + pkgPathEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath) : existingEnv - exit <- rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv) + shellEnv = [("HPCTIXFILE", tixFile) | isCoverageEnabled] ++ pkgPathEnv + + -- Add (DY)LD_LIBRARY_PATH if needed + shellEnv' <- if LBI.withDynExe lbi + then do let (Platform _ os) = LBI.hostPlatform lbi + clbi = LBI.getComponentLocalBuildInfo lbi + (LBI.CTestName (PD.testName suite)) + paths <- LBI.depLibraryPaths True False lbi clbi + return (addLibraryPath os paths shellEnv) + else return shellEnv + + exit <- rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv') -- these handles are automatically closed Nothing (Just wOut) (Just wOut) @@ -107,8 +123,8 @@ -- Write summary notice to terminal indicating end of test suite notice verbosity $ summarizeSuiteFinish suiteLog - markupTest verbosity lbi distPref - (display $ PD.package pkg_descr) suite + when isCoverageEnabled $ + markupTest verbosity lbi distPref (display $ PD.package pkg_descr) suite return suiteLog where @@ -136,8 +152,8 @@ pkg_descr lbi n l } --- TODO: This is abusing the notion of a 'PathTemplate'. The result --- isn't neccesarily a path. +-- TODO: This is abusing the notion of a 'PathTemplate'. The result isn't +-- necessarily a path. testOption :: PD.PackageDescription -> LBI.LocalBuildInfo -> PD.TestSuite @@ -147,6 +163,6 @@ fromPathTemplate $ substPathTemplate env template where env = initialPathTemplateEnv - (PD.package pkg_descr) (compilerId $ LBI.compiler lbi) - (LBI.hostPlatform lbi) ++ + (PD.package pkg_descr) (LBI.pkgKey lbi) + (compilerInfo $ LBI.compiler lbi) (LBI.hostPlatform lbi) ++ [(TestSuiteNameVar, toPathTemplate $ PD.testName suite)] diff --git a/Distribution/Simple/Test/LibV09.hs b/Distribution/Simple/Test/LibV09.hs --- a/Distribution/Simple/Test/LibV09.hs +++ b/Distribution/Simple/Test/LibV09.hs @@ -13,15 +13,18 @@ import qualified Distribution.PackageDescription as PD import Distribution.Simple.Build.PathsModule ( pkgPathEnvVar ) import Distribution.Simple.BuildPaths ( exeExtension ) -import Distribution.Simple.Compiler ( Compiler(..) ) -import Distribution.Simple.Hpc ( markupTest, tixDir, tixFilePath ) +import Distribution.Simple.Compiler ( compilerInfo ) +import Distribution.Simple.Hpc ( guessWay, markupTest, tixDir, tixFilePath ) import Distribution.Simple.InstallDirs ( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..) , substPathTemplate , toPathTemplate, PathTemplate ) import qualified Distribution.Simple.LocalBuildInfo as LBI -import Distribution.Simple.Setup ( TestFlags(..), TestShowDetails(..), fromFlag ) +import Distribution.Simple.Setup + ( TestFlags(..), TestShowDetails(..), fromFlag, configCoverage ) import Distribution.Simple.Test.Log -import Distribution.Simple.Utils ( die, notice, rawSystemIOWithEnv ) +import Distribution.Simple.Utils + ( die, notice, rawSystemIOWithEnv, addLibraryPath ) +import Distribution.System ( Platform (..) ) import Distribution.TestSuite import Distribution.Text import Distribution.Verbosity ( normal ) @@ -43,6 +46,9 @@ -> PD.TestSuite -> IO TestSuiteLog runTest pkg_descr lbi flags suite = do + let isCoverageEnabled = fromFlag $ configCoverage $ LBI.configFlags lbi + way = guessWay lbi + pwd <- getCurrentDirectory existingEnv <- getEnvironment @@ -55,12 +61,12 @@ -- Remove old .tix files if appropriate. unless (fromFlag $ testKeepTix flags) $ do - let tDir = tixDir distPref $ PD.testName suite + let tDir = tixDir distPref way $ PD.testName suite exists' <- doesDirectoryExist tDir when exists' $ removeDirectoryRecursive tDir -- Create directory for HPC files. - createDirectoryIfMissing True $ tixDir distPref $ PD.testName suite + createDirectoryIfMissing True $ tixDir distPref way $ PD.testName suite -- Write summary notices indicating start of test suite notice verbosity $ summarizeSuiteStart $ PD.testName suite @@ -78,11 +84,24 @@ -- Run test executable _ <- do let opts = map (testOption pkg_descr lbi suite) $ testOptions flags dataDirPath = pwd PD.dataDir pkg_descr - shellEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath) - : ("HPCTIXFILE", () pwd - $ tixFilePath distPref $ PD.testName suite) + tixFile = pwd tixFilePath distPref way (PD.testName suite) + pkgPathEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath) : existingEnv - rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv) + shellEnv = [("HPCTIXFILE", tixFile) | isCoverageEnabled] + ++ pkgPathEnv + -- Add (DY)LD_LIBRARY_PATH if needed + shellEnv' <- if LBI.withDynExe lbi + then do + let (Platform _ os) = LBI.hostPlatform lbi + clbi = LBI.getComponentLocalBuildInfo + lbi + (LBI.CTestName + (PD.testName suite)) + paths <- LBI.depLibraryPaths + True False lbi clbi + return (addLibraryPath os paths shellEnv) + else return shellEnv + rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv') -- these handles are closed automatically (Just rIn) (Just wOut) (Just wOut) @@ -120,8 +139,8 @@ -- Write summary notice to terminal indicating end of test suite notice verbosity $ summarizeSuiteFinish suiteLog - markupTest verbosity lbi distPref - (display $ PD.package pkg_descr) suite + when isCoverageEnabled $ + markupTest verbosity lbi distPref (display $ PD.package pkg_descr) suite return suiteLog where @@ -137,8 +156,8 @@ distPref = fromFlag $ testDistPref flags verbosity = fromFlag $ testVerbosity flags --- TODO: This is abusing the notion of a 'PathTemplate'. The result --- isn't neccesarily a path. +-- TODO: This is abusing the notion of a 'PathTemplate'. The result isn't +-- necessarily a path. testOption :: PD.PackageDescription -> LBI.LocalBuildInfo -> PD.TestSuite @@ -148,8 +167,8 @@ fromPathTemplate $ substPathTemplate env template where env = initialPathTemplateEnv - (PD.package pkg_descr) (compilerId $ LBI.compiler lbi) - (LBI.hostPlatform lbi) ++ + (PD.package pkg_descr) (LBI.pkgKey lbi) + (compilerInfo $ LBI.compiler lbi) (LBI.hostPlatform lbi) ++ [(TestSuiteNameVar, toPathTemplate $ PD.testName suite)] -- Test stub ---------- diff --git a/Distribution/Simple/Test/Log.hs b/Distribution/Simple/Test/Log.hs --- a/Distribution/Simple/Test/Log.hs +++ b/Distribution/Simple/Test/Log.hs @@ -13,7 +13,7 @@ import Distribution.Package ( PackageId ) import qualified Distribution.PackageDescription as PD -import Distribution.Simple.Compiler ( Compiler(..), CompilerId ) +import Distribution.Simple.Compiler ( Compiler(..), compilerInfo, CompilerId ) import Distribution.Simple.InstallDirs ( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..) , substPathTemplate , toPathTemplate, PathTemplate ) @@ -113,8 +113,8 @@ fromPathTemplate $ substPathTemplate env template where env = initialPathTemplateEnv - (PD.package pkg_descr) (compilerId $ LBI.compiler lbi) - (LBI.hostPlatform lbi) + (PD.package pkg_descr) (LBI.pkgKey lbi) + (compilerInfo $ LBI.compiler lbi) (LBI.hostPlatform lbi) ++ [ (TestSuiteNameVar, toPathTemplate name) , (TestSuiteResultVar, toPathTemplate $ resultString result) ] diff --git a/Distribution/Simple/UHC.hs b/Distribution/Simple/UHC.hs --- a/Distribution/Simple/UHC.hs +++ b/Distribution/Simple/UHC.hs @@ -24,7 +24,7 @@ import qualified Data.Map as M ( empty ) import Distribution.Compat.ReadP import Distribution.InstalledPackageInfo -import Distribution.Package +import Distribution.Package hiding (installedPackageId) import Distribution.PackageDescription import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler as C @@ -54,6 +54,8 @@ let comp = Compiler { compilerId = CompilerId UHC uhcVersion, + compilerAbiTag = C.NoAbiTag, + compilerCompat = [], compilerLanguages = uhcLanguages, compilerExtensions = uhcLanguageExtensions, compilerProperties = M.empty @@ -86,7 +88,7 @@ (FlexibleInstances, alwaysOn)] getInstalledPackages :: Verbosity -> Compiler -> PackageDBStack -> ProgramConfiguration - -> IO PackageIndex + -> IO InstalledPackageIndex getInstalledPackages verbosity comp packagedbs conf = do let compilerid = compilerId comp systemPkgDir <- rawSystemProgramStdoutConf verbosity uhcProgram conf ["--meta-pkgdir-system"] diff --git a/Distribution/Simple/UserHooks.hs b/Distribution/Simple/UserHooks.hs --- a/Distribution/Simple/UserHooks.hs +++ b/Distribution/Simple/UserHooks.hs @@ -144,7 +144,7 @@ -- |Hook to run before test command. preTest :: Args -> TestFlags -> IO HookedBuildInfo, -- |Over-ride this hook to get different behavior during test. - testHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> TestFlags -> IO (), + testHook :: Args -> PackageDescription -> LocalBuildInfo -> UserHooks -> TestFlags -> IO (), -- |Hook to run after test command. postTest :: Args -> TestFlags -> PackageDescription -> LocalBuildInfo -> IO (), @@ -200,7 +200,7 @@ haddockHook = ru, postHaddock = ru, preTest = rn', - testHook = ru, + testHook = \_ -> ru, postTest = ru, preBench = rn', benchHook = \_ -> ru, diff --git a/Distribution/Simple/Utils.hs b/Distribution/Simple/Utils.hs --- a/Distribution/Simple/Utils.hs +++ b/Distribution/Simple/Utils.hs @@ -24,6 +24,7 @@ topHandler, topHandlerWith, warn, notice, setupMessage, info, debug, debugNoWrap, chattyTry, + printRawCommandAndArgs, printRawCommandAndArgsAndEnv, -- * running programs rawSystemExit, @@ -53,6 +54,7 @@ installExecutableFiles, installMaybeExecutableFiles, installDirectoryContents, + copyDirectoryRecursive, -- * File permissions doesExecutableExist, @@ -61,6 +63,7 @@ -- * file names currentDir, + shortRelativePath, -- * finding files findFile, @@ -73,6 +76,7 @@ -- * environment variables isInSearchPath, + addLibraryPath, -- * simple file globbing matchFileGlob, @@ -110,11 +114,17 @@ normaliseLineEndings, -- * generic utils + dropWhileEndLE, + takeWhileEndLE, equating, comparing, isInfixOf, intercalate, lowercase, + listUnion, + listUnionRight, + ordNub, + ordNubRight, wrapText, wrapLine, ) where @@ -126,11 +136,12 @@ import Data.List ( nub, unfoldr, isPrefixOf, tails, intercalate ) import Data.Char as Char - ( toLower, chr, ord ) + ( isDigit, toLower, chr, ord ) import Data.Bits ( Bits((.|.), (.&.), shiftL, shiftR) ) import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy.Char8 as BS.Char8 +import qualified Data.Set as Set import System.Directory ( Permissions(executable), getDirectoryContents, getPermissions @@ -142,14 +153,15 @@ ( exitWith, ExitCode(..) ) import System.FilePath ( normalise, (), (<.>) - , getSearchPath, takeDirectory, splitFileName - , splitExtension, splitExtensions, splitDirectories ) + , getSearchPath, joinPath, takeDirectory, splitFileName + , splitExtension, splitExtensions, splitDirectories + , searchPathSeparator ) import System.Directory ( createDirectory, renameFile, removeDirectoryRecursive ) import System.IO - ( Handle, openFile, openBinaryFile, openBinaryTempFile + ( Handle, openFile, openBinaryFile, openBinaryTempFileWithDefaultPermissions , IOMode(ReadMode), hSetBinaryMode - , hGetContents, stdin, stderr, stdout, hPutStr, hFlush, hClose ) + , hGetContents, stderr, stdout, hPutStr, hFlush, hClose ) import System.IO.Error as IO.Error ( isDoesNotExistError, isAlreadyExistsError , ioeSetFileName, ioeGetFileName, ioeGetErrorString ) @@ -165,27 +177,18 @@ ( PackageIdentifier ) import Distribution.ModuleName (ModuleName) import qualified Distribution.ModuleName as ModuleName +import Distribution.System + ( OS (..) ) import Distribution.Version (Version(..)) import Control.Exception (IOException, evaluate, throwIO) -import System.Process (rawSystem) -import qualified System.Process as Process (CreateProcess(..)) - import Control.Concurrent (forkIO) -import System.Process (runInteractiveProcess, waitForProcess, proc, - StdStream(..)) -#if __GLASGOW_HASKELL__ >= 702 -import System.Process (showCommandForUser) -#endif - -#ifndef mingw32_HOST_OS -import System.Posix.Signals (installHandler, sigINT, sigQUIT, Handler(..)) -import System.Process.Internals (defaultSignal, runGenProcess_) -#else -import System.Process (createProcess) -#endif - +import qualified System.Process as Process + ( CreateProcess(..), StdStream(..), proc) +import System.Process + ( createProcess, rawSystem, runInteractiveProcess + , showCommandForUser, waitForProcess) import Distribution.Compat.CopyFile ( copyFile, copyOrdinaryFile, copyExecutableFile , setFileOrdinary, setFileExecutable, setDirOrdinary ) @@ -238,8 +241,8 @@ Nothing -> "" Just path -> path ++ location ++ ": " location = case ioeGetLocation ioe of - l@(n:_) | n >= '0' && n <= '9' -> ':' : l - _ -> "" + l@(n:_) | Char.isDigit n -> ':' : l + _ -> "" detail = ioeGetErrorString ioe topHandler :: IO a -> IO a @@ -343,61 +346,22 @@ unless (res == ExitSuccess) $ exitWith res printRawCommandAndArgs :: Verbosity -> FilePath -> [String] -> IO () -printRawCommandAndArgs verbosity path args - | verbosity >= deafening = print (path, args) - | verbosity >= verbose = -#if __GLASGOW_HASKELL__ >= 702 - putStrLn $ showCommandForUser path args -#else - putStrLn $ unwords (path : args) -#endif - | otherwise = return () +printRawCommandAndArgs verbosity path args = + printRawCommandAndArgsAndEnv verbosity path args Nothing printRawCommandAndArgsAndEnv :: Verbosity -> FilePath -> [String] - -> [(String, String)] + -> Maybe [(String, String)] -> IO () -printRawCommandAndArgsAndEnv verbosity path args env - | verbosity >= deafening = do putStrLn ("Environment: " ++ show env) - print (path, args) - | verbosity >= verbose = putStrLn $ unwords (path : args) +printRawCommandAndArgsAndEnv verbosity path args menv + | verbosity >= deafening = do + maybe (return ()) (putStrLn . ("Environment: " ++) . show) menv + print (path, args) + | verbosity >= verbose = putStrLn $ showCommandForUser path args | otherwise = return () --- This is taken directly from the process package. --- The reason we need it is that runProcess doesn't handle ^C in the same --- way that rawSystem handles it, but rawSystem doesn't allow us to pass --- an environment. -syncProcess :: String -> Process.CreateProcess -> IO ExitCode -#if mingw32_HOST_OS -syncProcess _fun c = do - (_,_,_,p) <- createProcess c - waitForProcess p -#else -syncProcess fun c = do - -- The POSIX version of system needs to do some manipulation of signal - -- handlers. Since we're going to be synchronously waiting for the child, - -- we want to ignore ^C in the parent, but handle it the default way - -- in the child (using SIG_DFL isn't really correct, it should be the - -- original signal handler, but the GHC RTS will have already set up - -- its own handler and we don't want to use that). - r <- Exception.bracket (installHandlers) (restoreHandlers) $ - (\_ -> do (_,_,_,p) <- runGenProcess_ fun c - (Just defaultSignal) (Just defaultSignal) - waitForProcess p) - return r - where - installHandlers = do - old_int <- installHandler sigINT Ignore Nothing - old_quit <- installHandler sigQUIT Ignore Nothing - return (old_int, old_quit) - restoreHandlers (old_int, old_quit) = do - _ <- installHandler sigINT old_int Nothing - _ <- installHandler sigQUIT old_quit Nothing - return () -#endif /* mingw32_HOST_OS */ - -- Exit with the same exit code if the subcommand fails rawSystemExit :: Verbosity -> FilePath -> [String] -> IO () rawSystemExit verbosity path args = do @@ -423,10 +387,19 @@ -> [(String, String)] -> IO () rawSystemExitWithEnv verbosity path args env = do - printRawCommandAndArgsAndEnv verbosity path args env + printRawCommandAndArgsAndEnv verbosity path args (Just env) hFlush stdout - exitcode <- syncProcess "rawSystemExitWithEnv" (proc path args) - { Process.env = Just env } + (_,_,_,ph) <- createProcess $ + (Process.proc path args) { Process.env = (Just env) +#ifdef MIN_VERSION_process +#if MIN_VERSION_process(1,2,0) +-- delegate_ctlc has been added in process 1.2, and we still want to be able to +-- bootstrap GHC on systems not having that version + , Process.delegate_ctlc = True +#endif +#endif + } + exitcode <- waitForProcess ph unless (exitcode == ExitSuccess) $ do debug verbosity $ path ++ " returned " ++ show exitcode exitWith exitcode @@ -442,29 +415,29 @@ -> Maybe Handle -- ^ stderr -> IO ExitCode rawSystemIOWithEnv verbosity path args mcwd menv inp out err = do - maybe (printRawCommandAndArgs verbosity path args) - (printRawCommandAndArgsAndEnv verbosity path args) menv + printRawCommandAndArgsAndEnv verbosity path args menv hFlush stdout - exitcode <- syncProcess "rawSystemIOWithEnv" (proc path args) - { Process.cwd = mcwd - , Process.env = menv - , Process.std_in = mbToStd inp - , Process.std_out = mbToStd out - , Process.std_err = mbToStd err } - `Exception.finally` (mapM_ maybeClose [inp, out, err]) + (_,_,_,ph) <- createProcess $ + (Process.proc path args) { Process.cwd = mcwd + , Process.env = menv + , Process.std_in = mbToStd inp + , Process.std_out = mbToStd out + , Process.std_err = mbToStd err +#ifdef MIN_VERSION_process +#if MIN_VERSION_process(1,2,0) +-- delegate_ctlc has been added in process 1.2, and we still want to be able to +-- bootstrap GHC on systems not having that version + , Process.delegate_ctlc = True +#endif +#endif + } + exitcode <- waitForProcess ph unless (exitcode == ExitSuccess) $ do debug verbosity $ path ++ " returned " ++ show exitcode return exitcode where - -- Also taken from System.Process - maybeClose :: Maybe Handle -> IO () - maybeClose (Just hdl) - | hdl /= stdin && hdl /= stdout && hdl /= stderr = hClose hdl - maybeClose _ = return () - - mbToStd :: Maybe Handle -> StdStream - mbToStd Nothing = Inherit - mbToStd (Just hdl) = UseHandle hdl + mbToStd :: Maybe Handle -> Process.StdStream + mbToStd = maybe Process.Inherit Process.UseHandle -- | Run a command and return its output. -- @@ -726,6 +699,25 @@ isInSearchPath :: FilePath -> IO Bool isInSearchPath path = fmap (elem path) getSearchPath +addLibraryPath :: OS + -> [FilePath] + -> [(String,String)] + -> [(String,String)] +addLibraryPath os paths = addEnv + where + pathsString = intercalate [searchPathSeparator] paths + ldPath = case os of + OSX -> "DYLD_LIBRARY_PATH" + _ -> "LD_LIBRARY_PATH" + + addEnv [] = [(ldPath,pathsString)] + addEnv ((key,value):xs) + | key == ldPath = + if null value + then (key,pathsString):xs + else (key,value ++ (searchPathSeparator:pathsString)):xs + | otherwise = (key,value):addEnv xs + ---------------- -- File globbing @@ -953,6 +945,13 @@ srcFiles <- getDirectoryContentsRecursive srcDir installOrdinaryFiles verbosity destDir [ (srcDir, f) | f <- srcFiles ] +-- | Recursively copy the contents of one directory to another path. +copyDirectoryRecursive :: Verbosity -> FilePath -> FilePath -> IO () +copyDirectoryRecursive verbosity srcDir destDir = do + info verbosity ("copy directory '" ++ srcDir ++ "' to '" ++ destDir ++ "'.") + srcFiles <- getDirectoryContentsRecursive srcDir + copyFilesWith (const copyFile) verbosity destDir [ (srcDir, f) | f <- srcFiles ] + ------------------- -- File permissions @@ -1056,7 +1055,7 @@ -- | Writes a file atomically. -- --- The file is either written sucessfully or an IO exception is raised and +-- The file is either written successfully or an IO exception is raised and -- the original file is left unchanged. -- -- On windows it is not possible to delete a file that is open by a process. @@ -1066,7 +1065,7 @@ writeFileAtomic targetPath content = do let (targetDir, targetFile) = splitFileName targetPath Exception.bracketOnError - (openBinaryTempFile targetDir $ targetFile <.> "tmp") + (openBinaryTempFileWithDefaultPermissions targetDir $ targetFile <.> "tmp") (\(tmpPath, handle) -> hClose handle >> removeFile tmpPath) (\(tmpPath, handle) -> do BS.hPut handle content @@ -1096,6 +1095,16 @@ currentDir :: FilePath currentDir = "." +shortRelativePath :: FilePath -> FilePath -> FilePath +shortRelativePath from to = + case dropCommonPrefix (splitDirectories from) (splitDirectories to) of + (stuff, path) -> joinPath (map (const "..") stuff ++ path) + where + dropCommonPrefix :: Eq a => [a] -> [a] -> ([a],[a]) + dropCommonPrefix (x:xs) (y:ys) + | x == y = dropCommonPrefix xs ys + dropCommonPrefix xs ys = (xs,ys) + -- ------------------------------------------------------------ -- * Finding the description file -- ------------------------------------------------------------ @@ -1269,6 +1278,84 @@ -- ------------------------------------------------------------ -- * Common utils -- ------------------------------------------------------------ + +-- | @dropWhileEndLE p@ is equivalent to @reverse . dropWhile p . reverse@, but +-- quite a bit faster. The difference between "Data.List.dropWhileEnd" and this +-- version is that the one in "Data.List" is strict in elements, but spine-lazy, +-- while this one is spine-strict but lazy in elements. That's what @LE@ stands +-- for - "lazy in elements". +-- +-- Example: +-- +-- @ +-- > tail $ Data.List.dropWhileEnd (<3) [undefined, 5, 4, 3, 2, 1] +-- *** Exception: Prelude.undefined +-- > tail $ dropWhileEndLE (<3) [undefined, 5, 4, 3, 2, 1] +-- [5,4,3] +-- > take 3 $ Data.List.dropWhileEnd (<3) [5, 4, 3, 2, 1, undefined] +-- [5,4,3] +-- > take 3 $ dropWhileEndLE (<3) [5, 4, 3, 2, 1, undefined] +-- *** Exception: Prelude.undefined +-- @ +dropWhileEndLE :: (a -> Bool) -> [a] -> [a] +dropWhileEndLE p = foldr (\x r -> if null r && p x then [] else x:r) [] + +-- | @takeWhileEndLE p@ is equivalent to @reverse . takeWhile p . reverse@, but +-- is usually faster (as well as being easier to read). +takeWhileEndLE :: (a -> Bool) -> [a] -> [a] +takeWhileEndLE p = fst . foldr go ([], False) + where + go x (rest, done) + | not done && p x = (x:rest, False) + | otherwise = (rest, True) + +-- | Like "Data.List.nub", but has @O(n log n)@ complexity instead of +-- @O(n^2)@. Code for 'ordNub' and 'listUnion' taken from Niklas Hambüchen's +-- package. +ordNub :: (Ord a) => [a] -> [a] +ordNub l = go Set.empty l + where + go _ [] = [] + go s (x:xs) = if x `Set.member` s then go s xs + else x : go (Set.insert x s) xs + +-- | Like "Data.List.union", but has @O(n log n)@ complexity instead of +-- @O(n^2)@. +listUnion :: (Ord a) => [a] -> [a] -> [a] +listUnion a b = a ++ ordNub (filter (`Set.notMember` aSet) b) + where + aSet = Set.fromList a + +-- | A right-biased version of 'ordNub'. +-- +-- Example: +-- +-- @ +-- > ordNub [1,2,1] +-- [1,2] +-- > ordNubRight [1,2,1] +-- [2,1] +-- @ +ordNubRight :: (Ord a) => [a] -> [a] +ordNubRight = fst . foldr go ([], Set.empty) + where + go x p@(l, s) = if x `Set.member` s then p + else (x:l, Set.insert x s) + +-- | A right-biased version of 'listUnion'. +-- +-- Example: +-- +-- @ +-- > listUnion [1,2,3,4,3] [2,1,1] +-- [1,2,3,4,3] +-- > listUnionRight [1,2,3,4,3] [2,1,1] +-- [4,3,2,1,1] +-- @ +listUnionRight :: (Ord a) => [a] -> [a] -> [a] +listUnionRight a b = ordNubRight (filter (`Set.notMember` bSet) a) ++ b + where + bSet = Set.fromList b equating :: Eq a => (b -> a) -> b -> b -> Bool equating p x y = p x == p y diff --git a/Distribution/System.hs b/Distribution/System.hs --- a/Distribution/System.hs +++ b/Distribution/System.hs @@ -1,4 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.System @@ -32,11 +34,13 @@ import qualified System.Info (os, arch) import qualified Data.Char as Char (toLower, isAlphaNum) +import Data.Binary (Binary) import Data.Data (Data) import Data.Typeable (Typeable) import Data.Maybe (fromMaybe, listToMaybe) import Distribution.Text (Text(..), display) import qualified Distribution.Compat.ReadP as Parse +import GHC.Generics (Generic) import qualified Text.PrettyPrint as Disp import Text.PrettyPrint ((<>)) @@ -69,9 +73,12 @@ | Solaris | AIX | HPUX | IRIX -- ageing Unix OSs | HaLVM -- bare metal / VMs / hypervisors | IOS -- iOS + | Ghcjs | OtherOS String - deriving (Eq, Ord, Show, Read, Typeable, Data) + deriving (Eq, Generic, Ord, Show, Read, Typeable, Data) +instance Binary OS + --TODO: decide how to handle Android and iOS. -- They are like Linux and OSX but with some differences. -- Should they be separate from Linux/OS X, or a subtype? @@ -82,7 +89,8 @@ ,FreeBSD, OpenBSD, NetBSD, DragonFly ,Solaris, AIX, HPUX, IRIX ,HaLVM - ,IOS] + ,IOS + ,Ghcjs] osAliases :: ClassificationStrictness -> OS -> [String] osAliases Permissive Windows = ["mingw32", "win32", "cygwin32"] @@ -120,15 +128,19 @@ | IA64 | S390 | Alpha | Hppa | Rs6000 | M68k | Vax + | JavaScript | OtherArch String - deriving (Eq, Ord, Show, Read, Typeable, Data) + deriving (Eq, Generic, Ord, Show, Read, Typeable, Data) +instance Binary Arch + knownArches :: [Arch] knownArches = [I386, X86_64, PPC, PPC64, Sparc ,Arm, Mips, SH ,IA64, S390 ,Alpha, Hppa, Rs6000 - ,M68k, Vax] + ,M68k, Vax + ,JavaScript] archAliases :: ClassificationStrictness -> Arch -> [String] archAliases Strict _ = [] @@ -162,7 +174,9 @@ -- ------------------------------------------------------------ data Platform = Platform Arch OS - deriving (Eq, Ord, Show, Read, Typeable, Data) + deriving (Eq, Generic, Ord, Show, Read, Typeable, Data) + +instance Binary Platform instance Text Platform where disp (Platform arch os) = disp arch <> Disp.char '-' <> disp os diff --git a/Distribution/Utils/NubList.hs b/Distribution/Utils/NubList.hs new file mode 100644 --- /dev/null +++ b/Distribution/Utils/NubList.hs @@ -0,0 +1,97 @@ +module Distribution.Utils.NubList + ( NubList -- opaque + , toNubList -- smart construtor + , fromNubList + , overNubList + + , NubListR + , toNubListR + , fromNubListR + , overNubListR + ) where + +import Data.Binary +import Data.Monoid + +import Distribution.Simple.Utils (ordNub, listUnion, ordNubRight, listUnionRight) + +import qualified Text.Read as R + +-- | NubList : A de-duplicated list that maintains the original order. +newtype NubList a = + NubList { fromNubList :: [a] } + deriving Eq + +-- NubList assumes that nub retains the list order while removing duplicate +-- elements (keeping the first occurence). Documentation for "Data.List.nub" +-- does not specifically state that ordering is maintained so we will add a test +-- for that to the test suite. + +-- | Smart constructor for the NubList type. +toNubList :: Ord a => [a] -> NubList a +toNubList list = NubList $ ordNub list + +-- | Lift a function over lists to a function over NubLists. +overNubList :: Ord a => ([a] -> [a]) -> NubList a -> NubList a +overNubList f (NubList list) = toNubList . f $ list + +-- | Monoid operations on NubLists. +-- For a valid Monoid instance we need to satistfy the required monoid laws; +-- identity, associativity and closure. +-- +-- Identity : by inspection: +-- mempty `mappend` NubList xs == NubList xs `mappend` mempty +-- +-- Associativity : by inspection: +-- (NubList xs `mappend` NubList ys) `mappend` NubList zs +-- == NubList xs `mappend` (NubList ys `mappend` NubList zs) +-- +-- Closure : appending two lists of type a and removing duplicates obviously +-- does not change the type. + +instance Ord a => Monoid (NubList a) where + mempty = NubList [] + mappend (NubList xs) (NubList ys) = NubList $ xs `listUnion` ys + +instance Show a => Show (NubList a) where + show (NubList list) = show list + +instance (Ord a, Read a) => Read (NubList a) where + readPrec = readNubList toNubList + +-- | Helper used by NubList/NubListR's Read instances. +readNubList :: (Ord a, Read a) => ([a] -> l a) -> R.ReadPrec (l a) +readNubList toList = R.parens . R.prec 10 $ fmap toList R.readPrec + +-- | Binary instance for 'NubList a' is the same as for '[a]'. For 'put', we +-- just pull off constructor and put the list. For 'get', we get the list and +-- make a 'NubList' out of it using 'toNubList'. +instance (Ord a, Binary a) => Binary (NubList a) where + put (NubList l) = put l + get = fmap toNubList get + +-- | NubListR : A right-biased version of 'NubList'. That is @toNubListR +-- ["-XNoFoo", "-XFoo", "-XNoFoo"]@ will result in @["-XFoo", "-XNoFoo"]@, +-- unlike the normal 'NubList', which is left-biased. Built on top of +-- 'ordNubRight' and 'listUnionRight'. +newtype NubListR a = + NubListR { fromNubListR :: [a] } + deriving Eq + +-- | Smart constructor for the NubListR type. +toNubListR :: Ord a => [a] -> NubListR a +toNubListR list = NubListR $ ordNubRight list + +-- | Lift a function over lists to a function over NubListRs. +overNubListR :: Ord a => ([a] -> [a]) -> NubListR a -> NubListR a +overNubListR f (NubListR list) = toNubListR . f $ list + +instance Ord a => Monoid (NubListR a) where + mempty = NubListR [] + mappend (NubListR xs) (NubListR ys) = NubListR $ xs `listUnionRight` ys + +instance Show a => Show (NubListR a) where + show (NubListR list) = show list + +instance (Ord a, Read a) => Read (NubListR a) where + readPrec = readNubList toNubListR diff --git a/Distribution/Verbosity.hs b/Distribution/Verbosity.hs --- a/Distribution/Verbosity.hs +++ b/Distribution/Verbosity.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.Verbosity @@ -22,11 +24,15 @@ showForCabal, showForGHC ) where +import Data.Binary import Data.List (elemIndex) import Distribution.ReadE +import GHC.Generics data Verbosity = Silent | Normal | Verbose | Deafening - deriving (Show, Read, Eq, Ord, Enum, Bounded) + deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded) + +instance Binary Verbosity -- We shouldn't print /anything/ unless an error occurs in silent mode silent :: Verbosity diff --git a/Distribution/Version.hs b/Distribution/Version.hs --- a/Distribution/Version.hs +++ b/Distribution/Version.hs @@ -1,4 +1,10 @@ -{-# LANGUAGE CPP, DeriveDataTypeable, StandaloneDeriving #-} +{-# LANGUAGE CPP, DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +#if __GLASGOW_HASKELL__ < 707 +{-# LANGUAGE StandaloneDeriving #-} +#endif +{-# OPTIONS_GHC -fno-warn-orphans #-} + ----------------------------------------------------------------------------- -- | -- Module : Distribution.Version @@ -65,9 +71,11 @@ ) where +import Data.Binary ( Binary(..) ) import Data.Data ( Data ) import Data.Typeable ( Typeable ) import Data.Version ( Version(..) ) +import GHC.Generics ( Generic ) import Distribution.Text ( Text(..) ) import qualified Distribution.Compat.ReadP as Parse @@ -92,13 +100,26 @@ | UnionVersionRanges VersionRange VersionRange | IntersectVersionRanges VersionRange VersionRange | VersionRangeParens VersionRange -- just '(exp)' parentheses syntax - deriving (Show,Read,Eq,Typeable,Data) + deriving (Data, Eq, Generic, Read, Show, Typeable) +instance Binary VersionRange + #if __GLASGOW_HASKELL__ < 707 -- starting with ghc-7.7/base-4.7 this instance is provided in "Data.Data" deriving instance Data Version #endif +-- Deriving this instance from Generic gives trouble on GHC 7.2 because the +-- Generic instance has to be standalone-derived. So, we hand-roll our own. +-- We can't use a generic Binary instance on later versions because we must +-- maintain compatibility between compiler versions. +instance Binary Version where + get = do + br <- get + tags <- get + return $ Version br tags + put (Version br tags) = put br >> put tags + {-# DEPRECATED AnyVersion "Use 'anyVersion', 'foldVersionRange' or 'asVersionIntervals'" #-} {-# DEPRECATED ThisVersion "use 'thisVersion', 'foldVersionRange' or 'asVersionIntervals'" #-} {-# DEPRECATED LaterVersion "use 'laterVersion', 'foldVersionRange' or 'asVersionIntervals'" #-} @@ -701,9 +722,11 @@ return f) factor = Parse.choice $ parens expr : parseAnyVersion + : parseNoVersion : parseWildcardRange : map parseRangeOp rangeOps parseAnyVersion = Parse.string "-any" >> return AnyVersion + parseNoVersion = Parse.string "-none" >> return noVersion parseWildcardRange = do _ <- Parse.string "==" diff --git a/Language/Haskell/Extension.hs b/Language/Haskell/Extension.hs --- a/Language/Haskell/Extension.hs +++ b/Language/Haskell/Extension.hs @@ -1,4 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} + ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Extension @@ -25,8 +27,10 @@ import qualified Text.PrettyPrint as Disp import qualified Data.Char as Char (isAlphaNum) import Data.Array (Array, accumArray, bounds, Ix(inRange), (!)) +import Data.Binary (Binary) import Data.Data (Data) import Data.Typeable (Typeable) +import GHC.Generics (Generic) -- ------------------------------------------------------------ -- * Language @@ -49,8 +53,10 @@ -- | An unknown language, identified by its name. | UnknownLanguage String - deriving (Show, Read, Eq, Typeable, Data) + deriving (Generic, Show, Read, Eq, Typeable, Data) +instance Binary Language + knownLanguages :: [Language] knownLanguages = [Haskell98, Haskell2010] @@ -77,7 +83,7 @@ -- Note: if you add a new 'KnownExtension': -- -- * also add it to the Distribution.Simple.X.languageExtensions lists --- (where X is each compiler: GHC, JHC, Hugs, NHC) +-- (where X is each compiler: GHC, JHC, LHC, UHC, HaskellSuite) -- -- | This represents language extensions beyond a base 'Language' definition -- (such as 'Haskell98') that are supported by some implementations, usually @@ -97,8 +103,10 @@ -- pragma. | UnknownExtension String - deriving (Show, Read, Eq, Typeable, Data) + deriving (Generic, Show, Read, Eq, Ord, Typeable, Data) +instance Binary Extension + data KnownExtension = -- | Allow overlapping class instances, provided there is a unique @@ -123,11 +131,11 @@ -- * | IncoherentInstances - -- | /(deprecated)/ Allows recursive bindings in @do@ blocks, using the @rec@ + -- | /(deprecated)/ Allow recursive bindings in @do@ blocks, using the @rec@ -- keyword. See also 'RecursiveDo'. | DoRec - -- | Allows recursive bindings using @mdo@, a variant of @do@. + -- | Allow recursive bindings using @mdo@, a variant of @do@. -- @DoRec@ provides a different, preferred syntax. -- -- * @@ -504,13 +512,13 @@ -- and Josef Svenningsson, from ICFP '04. | RegularPatterns - -- | Enables the use of tuple sections, e.g. @(, True)@ desugars into + -- | Enable the use of tuple sections, e.g. @(, True)@ desugars into -- @\x -> (x, True)@. -- -- * | TupleSections - -- | Allows GHC primops, written in C--, to be imported into a Haskell + -- | Allow GHC primops, written in C--, to be imported into a Haskell -- file. | GHCForeignImportPrim @@ -628,7 +636,7 @@ -- * | ParallelArrays - -- | Enable explicit role annotations, like in (@data T a\@R@). + -- | Enable explicit role annotations, like in (@type role Foo representational representational@). -- -- * | RoleAnnotations @@ -639,7 +647,7 @@ -- * | OverloadedLists - -- | Enables case expressions that have no alternatives. Also applies to lambda-case expressions if they are enabled. + -- | Enable case expressions that have no alternatives. Also applies to lambda-case expressions if they are enabled. -- -- * | EmptyCase @@ -655,17 +663,17 @@ -- * | NegativeLiterals - -- | Allows the use of binary integer literal syntax (e.g. @0b11001001@ to denote @201@). + -- | Allow the use of binary integer literal syntax (e.g. @0b11001001@ to denote @201@). -- -- * | BinaryLiterals - -- | Allows the use of floating literal syntax for all instances of 'Num', including 'Int' and 'Integer'. + -- | Allow the use of floating literal syntax for all instances of 'Num', including 'Int' and 'Integer'. -- -- * | NumDecimals - -- | Enables support for type classes with no type parameter. + -- | Enable support for type classes with no type parameter. -- -- * | NullaryTypeClasses @@ -680,7 +688,35 @@ -- * | AllowAmbiguousTypes - deriving (Show, Read, Eq, Enum, Bounded, Typeable, Data) + -- | Enable @foreign import javascript@. + | JavaScriptFFI + + -- | Allow giving names to and abstracting over patterns. + -- + -- * + | PatternSynonyms + + -- | Allow anonymous placeholders (underscore) inside type signatures. The + -- type inference engine will generate a message describing the type inferred + -- at the hole's location. + -- + -- * + | PartialTypeSignatures + + -- | Allow named placeholders written with a leading underscore inside type + -- signatures. Wildcards with the same name unify to the same type. + -- + -- * + | NamedWildCards + + -- | Enable @deriving@ for any class. + -- + -- * + | DeriveAnyClass + + deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded, Typeable, Data) + +instance Binary KnownExtension {-# DEPRECATED knownExtensions "KnownExtension is an instance of Enum and Bounded, use those instead." #-} diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -1,179 +0,0 @@ -The Cabal library package -========================= - -[Cabal home page](http://www.haskell.org/cabal/) - -If you also want the `cabal` command line program then you need -the `cabal-install` package in addition to this library. - - -Installation instructions for the Cabal library -=============================================== - -If you have the `cabal` program already ---------------------------------------- - -In this case it's simple, just - - cabal install - -Of course, if you don't have an existing version of the `cabal` program -then to get one you'd first need to install the Cabal library! To avoid -this bootstrapping problem, you can install the Cabal library directly: - -Installing as a user (no root or administrator access) ------------------------------------------------------- - - ghc -threaded --make Setup - ./Setup configure --user - ./Setup build - ./Setup install - -Note the use of the `--user` flag at the configure step. - -Compiling Setup rather than using `runghc Setup` is much faster and works on -Windows. For all packages other than Cabal itself it is fine to use `runghc`. - -This will install into `$HOME/.cabal/` on unix and into -`$Documents and Settings\$User\Application Data\cabal\` on Windows -If you want to install elsewhere use the `--prefix=` flag at the -configure step. - - -Installing as root / Administrator ----------------------------------- - - ghc -threaded --make Setup - ./Setup configure - ./Setup build - sudo ./Setup install - -Compiling Setup rather than using `runghc Setup` is much faster and works on -Windows. For all packages other than Cabal itself it is fine to use `runghc`. - -This will install into `/usr/local` on unix and on Windows it will -install into `$ProgramFiles/Haskell`. If you want to install -elsewhere use the `--prefix=` flag at the configure step. - - -Working with older versions of GHC and Cabal -============================================ - -It is recommended just to leave any pre-existing version of Cabal -installed. In particular it is *essential* to keep the version that -came with GHC itself since other installed packages need it (eg the -"ghc" api package). - -Prior to GHC 6.4.2 however, GHC didn't deal particularly well with -having multiple versions of packages installed at once. So if you -are using GHC 6.4.1 or older and you have an older version of Cabal -installed, you probably just want to remove it: - - ghc-pkg unregister Cabal - -or if you had Cabal installed just for your user account then: - - ghc-pkg unregister Cabal --user - - -The `filepath` dependency -========================= - -Cabal now uses the `filepath` package so that must be installed first. -GHC-6.6.1 and later come with `filepath` however earlier versions do not by -default. If you do not already have `filepath` then you need to install it. You -can use any existing version of Cabal to do that. If you have neither Cabal or -filepath then it is slightly harder but still possible. - -Unpack Cabal and filepath into separate directories. For example: - - tar -xzf filepath-1.1.0.0.tar.gz - tar -xzf Cabal-1.6.0.0.tar.gz - - # rename to make the following instructions simpler: - mv filepath-1.1.0.0/ filepath/ - mv Cabal-1.6.0.0/ Cabal/ - - cd Cabal - ghc -i../filepath -cpp --make Setup.hs -o ../filepath/setup - cd ../filepath/ - ./setup configure --user - ./setup build - ./setup install - -This installs filepath so you are then in a position to install Cabal by the -normal method. - - -More Information -================ - -Please see the web site for the [user guide] and API documentation. -There is some more information available on the [development wiki]. - -[user guide]: http://www.haskell.org/cabal/ -[development wiki]: http://hackage.haskell.org/trac/hackage/ - - -Bugs -======= - -Please report bugs and wish-list items in our [bug tracker]. - -[bug tracker]: https://github.com/haskell/cabal/issues - - -Your Help ---------- - -To help us in the next round of development work it would be -enormously helpful to know from our users what their most pressing -problems are with Cabal and Hackage. You probably have a favourite -Cabal bug or limitation. Take a look at our [bug tracker]. Make sure -the problem is reported there and properly described. Comment on the -ticket to tell us how much of a problem the bug is for you. Add -yourself to the ticket's cc list so we can discuss requirements and -keep you informed on progress. For feature requests it is very -helpful if there is a description of how you would expect to -interact with the new feature. - - -Code -======= - -You can get the code from the web page; the version control system we -use is very open and welcoming to new developers. - -You can get the main development branch: - -> darcs get --partial http://darcs.haskell.org/cabal - -and you can get the stable 1.6 branch: - -> darcs get --partial http://darcs.haskell.org/cabal-branches/cabal-1.6 - - -Credits -======= - -Cabal Coders (in alphabetical order): - -- Krasimir Angelov -- Bjorn Bringert -- Duncan Coutts -- Isaac Jones -- David Himmelstrup (Lemmih) -- Simon Marlow -- Ross Patterson -- Thomas Schilling -- Martin Sjögren -- Malcolm Wallace -- and nearly 30 other people have contributed occasional patches - -Cabal spec: - -- Isaac Jones -- Simon Marlow -- Ross Patterson -- Simon Peyton Jones -- Malcolm Wallace diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,182 @@ +The Cabal library package +========================= + +See the [Cabal web site] for more information. + +If you also want the `cabal` command-line program, you need the +[cabal-install] package in addition to this library. + +[cabal-install]: ../cabal-install/README.md + +Installing the Cabal library +============================ + +If you already have the `cabal` program +--------------------------------------- + +In this case run: + + $ cabal install + +However, if you do not have an existing version of the `cabal` program, +you first must install the Cabal library. To avoid this bootstrapping +problem, you can install the Cabal library directly as described below. + + +Installing as a user (no root or administrator access) +------------------------------------------------------ + + ghc -threaded --make Setup + ./Setup configure --user + ./Setup build + ./Setup install + +Note the use of the `--user` flag at the configure step. + +Compiling 'Setup' rather than using `runghc Setup` is much faster and +works on Windows. For all packages other than Cabal itself, it is fine +to use `runghc`. + +This will install into `$HOME/.cabal/` on Unix and into +`Documents and Settings\$User\Application Data\cabal\` on Windows. +If you want to install elsewhere, use the `--prefix=` flag at the +configure step. + + +Installing as root or Administrator +----------------------------------- + + ghc -threaded --make Setup + ./Setup configure + ./Setup build + sudo ./Setup install + +Compiling Setup rather than using `runghc Setup` is much faster and +works on Windows. For all packages other than Cabal itself, it is fine +to use `runghc`. + +This will install into `/usr/local` on Unix, and on Windows it will +install into `$ProgramFiles/Haskell`. If you want to install elsewhere, +use the `--prefix=` flag at the configure step. + + +Using older versions of GHC and Cabal +====================================== + +It is recommended that you leave any pre-existing version of Cabal +installed. In particular, it is *essential* you keep the version that +came with GHC itself, since other installed packages require it (for +instance, the "ghc" API package). + +Prior to GHC 6.4.2, however, GHC did not deal particularly well with +having multiple versions of packages installed at once. So if you are +using GHC 6.4.1 or older and you have an older version of Cabal +installed, you should probably remove it by running: + + $ ghc-pkg unregister Cabal + +or, if you had Cabal installed only for your user account, run: + + $ ghc-pkg unregister Cabal --user + +The `filepath` dependency +========================= + +Cabal uses the [filepath] package, so it must be installed first. +GHC version 6.6.1 and later come with `filepath`, however, earlier +versions do not by default. If you do not already have `filepath`, +you need to install it. You can use any existing version of Cabal to do +that. If you have neither Cabal nor `filepath`, it is slightly +harder but still possible. + +Unpack Cabal and `filepath` into separate directories. For example: + + tar -xzf filepath-1.1.0.0.tar.gz + tar -xzf Cabal-1.6.0.0.tar.gz + + # rename to make the following instructions simpler: + mv filepath-1.1.0.0/ filepath/ + mv Cabal-1.6.0.0/ Cabal/ + + cd Cabal + ghc -i../filepath -cpp --make Setup.hs -o ../filepath/setup + cd ../filepath/ + ./setup configure --user + ./setup build + ./setup install + +This installs `filepath` so that you can install Cabal with the normal +method. + +[filepath]: http://hackage.haskell.org/package/filepath + +More information +================ + +Please see the [Cabal web site] for the [user guide] and [API +documentation]. There is additional information available on the +[development wiki]. + +[user guide]: http://www.haskell.org/cabal/users-guide +[API documentation]: http://www.haskell.org/cabal/release/cabal-latest/doc/API/Cabal/Distribution-Simple.html +[development wiki]: https://github.com/haskell/cabal/wiki + + +Bugs +==== + +Please report bugs and feature requests to Cabal's [bug tracker]. + + +Your help +--------- + +To help Cabal's development, it is enormously helpful to know from +Cabal's users what their most pressing problems are with Cabal and +[Hackage]. You may have a favourite Cabal bug or limitation. Look at +Cabal's [bug tracker]. Ensure that the problem is reported there and +adequately described. Comment on the issue to report how much of a +problem the bug is for you. Subscribe to the issues's notifications to +discussed requirements and keep informed on progress. For feature +requests, it is helpful if there is a description of how you would +expect to interact with the new feature. + +[Hackage]: http://hackage.haskell.org + + +Source code +=========== + +You can get the master development branch using: + + $ git clone https://github.com/haskell/cabal.git + + +Credits +======= + +Cabal developers (in alphabetical order): + +- Krasimir Angelov +- Bjorn Bringert +- Duncan Coutts +- Isaac Jones +- David Himmelstrup ("Lemmih") +- Simon Marlow +- Ross Patterson +- Thomas Schilling +- Martin Sjögren +- Malcolm Wallace +- and nearly 30 other people have contributed occasional patches + +Cabal specification authors: + +- Isaac Jones +- Simon Marlow +- Ross Patterson +- Simon Peyton Jones +- Malcolm Wallace + + +[bug tracker]: https://github.com/haskell/cabal/issues +[Cabal web site]: http://www.haskell.org/cabal/ diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,7 +1,37 @@ -*-change-log-*- -1.20.0.4 Ryan Thomas January 2016 - * Cabal.cabal: change build-type to Simple. +1.22.0.0 Johan Tibell January 2015 + * Support GHC 7.10. + * Experimental support for emitting DWARF debug info. + * Preliminary support for relocatable packages. + * Allow cabal to be used inside cabal exec enviroments. + * hpc: support mutliple "ways" (e.g. profiling and vanilla). + * Support GHCJS. + * Improved command line documentation. + * Add '-none' constraint syntax for version ranges (#2093). + * Make the default doc index file path compiler/arch/os-dependent + (#2136). + * Warn instead of dying when generating documentation and hscolour + isn't installed (455f51622fa38347db62197a04bb0fa5b928ff17). + * Support the new BinaryLiterals extension + (1f25ab3c5eff311ada73c6c987061b80e9bbebd9). + * Warn about 'ghc-prof-options: -auto-all' in 'cabal check' (#2162). + * Add preliminary support for multiple instances of the same package + version installed side-by-side (#2002). + * New binary build config format - faster build times (#2076). + * Support module thinning and renaming (#2038). + * Add a new license type: UnspecifiedLicense (#2141). + * Remove support for Hugs and nhc98 (#2168). + * Invoke 'tar' with '--formar ustar' if possible in 'sdist' (#1903). + * Replace --enable-library-coverage with --enable-coverage, which + enables program coverage for all components (#1945). + * Suggest that `ExitFailure 9` is probably due to memory + exhaustion (#1522). + * Drop support for Haddock < 2.0 (#1808, #1718). + * Make 'cabal test'/'cabal bench' build only what's needed for + running tests/benchmarks (#1821). + * Build shared libraries by default when linking executables dynamically. + * Build profiled libraries by default when profiling executables. 1.20.0.1 Johan Tibell May 2014 * Fix streaming test output. @@ -17,7 +47,7 @@ * Don't call ranlib on OS X * Avoid re-linking executables, test suites, and benchmarks unnecessarily, shortening build times - * Add --allow-never which allows upper version bounds to be + * Add --allow-newer which allows upper version bounds to be ignored * Add --enable-library-stripping * Add command for freezing dependencies @@ -31,10 +61,6 @@ * Improve pretty-printing of Cabal files * Add test flag --show-details=streaming for real-time test output * Add exec command - -1.11.x (current development version) - -1.10.0.x (next stable release version) 1.10.2.0 Duncan Coutts June 2011 * Include test suites in cabal sdist diff --git a/doc/developing-packages.markdown b/doc/developing-packages.markdown new file mode 100644 --- /dev/null +++ b/doc/developing-packages.markdown @@ -0,0 +1,2146 @@ +% Cabal User Guide: Developing Cabal packages + + +# Quickstart # + + +Lets assume we have created a project directory and already have a +Haskell module or two. + +Every project needs a name, we'll call this example "proglet". + +~~~~~~~~~~~ +$ cd proglet/ +$ ls +Proglet.hs +~~~~~~~~~~~ + +It is assumed that (apart from external dependencies) all the files that +make up a package live under a common project root directory. This +simple example has all the project files in one directory, but most +packages will use one or more subdirectories. + +To turn this into a Cabal package we need two extra files in the +project's root directory: + + * `proglet.cabal`: containing package metadata and build information. + + * `Setup.hs`: usually containing a few standardized lines of code, but + can be customized if necessary. + +We can create both files manually or we can use `cabal init` to create +them for us. + +### Using "cabal init" ### + +The `cabal init` command is interactive. It asks us a number of +questions starting with the package name and version. + +~~~~~~~~~~ +$ cabal init +Package name [default "proglet"]? +Package version [default "0.1"]? +... +~~~~~~~~~~ + +It also asks questions about various other bits of package metadata. For +a package that you never intend to distribute to others, these fields can +be left blank. + +One of the important questions is whether the package contains a library +or an executable. Libraries are collections of Haskell modules that can +be re-used by other Haskell libraries and programs, while executables +are standalone programs. + +~~~~~~~~~~ +What does the package build: + 1) Library + 2) Executable +Your choice? +~~~~~~~~~~ + +For the moment these are the only choices. For more complex packages +(e.g. a library and multiple executables or test suites) the `.cabal` +file can be edited afterwards. + +Finally, `cabal init` creates the initial `proglet.cabal` and `Setup.hs` +files, and depending on your choice of license, a `LICENSE` file as well. + +~~~~~~~~~~ +Generating LICENSE... +Generating Setup.hs... +Generating proglet.cabal... + +You may want to edit the .cabal file and add a Description field. +~~~~~~~~~~ + +As this stage the `proglet.cabal` is not quite complete and before you +are able to build the package you will need to edit the file and add +some build information about the library or executable. + +### Editing the .cabal file ### + +Load up the `.cabal` file in a text editor. The first part of the +`.cabal` file has the package metadata and towards the end of the file +you will find the `executable` or `library` section. + +You will see that the fields that have yet to be filled in are commented +out. Cabal files use "`--`" Haskell-style comment syntax. (Note that +comments are only allowed on lines on their own. Trailing comments on +other lines are not allowed because they could be confused with program +options.) + +If you selected earlier to create a library package then your `.cabal` +file will have a section that looks like this: + +~~~~~~~~~~~~~~~~~ +library + exposed-modules: Proglet + -- other-modules: + -- build-depends: +~~~~~~~~~~~~~~~~~ + +Alternatively, if you selected an executable then there will be a +section like: + +~~~~~~~~~~~~~~~~~ +executable proglet + -- main-is: + -- other-modules: + -- build-depends: +~~~~~~~~~~~~~~~~~ + +The build information fields listed (but commented out) are just the few +most important and common fields. There are many others that are covered +later in this chapter. + +Most of the build information fields are the same between libraries and +executables. The difference is that libraries have a number of "exposed" +modules that make up the public interface of the library, while +executables have a file containing a `Main` module. + +The name of a library always matches the name of the package, so it is +not specified in the library section. Executables often follow the name +of the package too, but this is not required and the name is given +explicitly. + +### Modules included in the package ### + +For a library, `cabal init` looks in the project directory for files +that look like Haskell modules and adds all the modules to the +`exposed-modules` field. For modules that do not form part of your +package's public interface, you can move those modules to the +`other-modules` field. Either way, all modules in the library need to be +listed. + +For an executable, `cabal init` does not try to guess which file +contains your program's `Main` module. You will need to fill in the +`main-is` field with the file name of your program's `Main` module +(including `.hs` or `.lhs` extension). Other modules included in the +executable should be listed in the `other-modules` field. + +### Modules imported from other packages ### + +While your library or executable may include a number of modules, it +almost certainly also imports a number of external modules from the +standard libraries or other pre-packaged libraries. (These other +libraries are of course just Cabal packages that contain a library.) + +You have to list all of the library packages that your library or +executable imports modules from. Or to put it another way: you have to +list all the other packages that your package depends on. + +For example, suppose the example `Proglet` module imports the module +`Data.Map`. The `Data.Map` module comes from the `containers` package, +so we must list it: + +~~~~~~~~~~~~~~~~~ +library + exposed-modules: Proglet + other-modules: + build-depends: containers, base == 4.* +~~~~~~~~~~~~~~~~~ + +In addition, almost every package also depends on the `base` library +package because it exports the standard `Prelude` module plus other +basic modules like `Data.List`. + +You will notice that we have listed `base == 4.*`. This gives a +constraint on the version of the base package that our package will work +with. The most common kinds of constraints are: + + * `pkgname >= n` + * `pkgname >= n && < m` + * `pkgname == n.*` + +The last is just shorthand, for example `base == 4.*` means exactly the +same thing as `base >= 4 && < 5`. + +### Building the package ### + +For simple packages that's it! We can now try configuring and building +the package: + +~~~~~~~~~~~~~~~~ +cabal configure +cabal build +~~~~~~~~~~~~~~~~ + +Assuming those two steps worked then you can also install the package: + +~~~~~~~~~~~~~~~~ +cabal install +~~~~~~~~~~~~~~~~ + +For libraries this makes them available for use in GHCi or to be used by +other packages. For executables it installs the program so that you can +run it (though you may first need to adjust your system's `$PATH`). + +### Next steps ### + +What we have covered so far should be enough for very simple packages +that you use on your own system. + +The next few sections cover more details needed for more complex +packages and details needed for distributing packages to other people. + +The previous chapter covers building and installing packages -- your own +packages or ones developed by other people. + + +# Package concepts # + +Before diving into the details of writing packages it helps to +understand a bit about packages in the Haskell world and the particular +approach that Cabal takes. + +### The point of packages ### + +Packages are a mechanism for organising and distributing code. Packages +are particularly suited for "programming in the large", that is building +big systems by using and re-using code written by different people at +different times. + +People organise code into packages based on functionality and +dependencies. Social factors are also important: most packages have a +single author, or a relatively small team of authors. + +Packages are also used for distribution: the idea is that a package can +be created in one place and be moved to a different computer and be +usable in that different environment. There are a surprising number of +details that have to be got right for this to work, and a good package +system helps to simply this process and make it reliable. + +Packages come in two main flavours: libraries of reusable code, and +complete programs. Libraries present a code interface, an API, while +programs can be run directly. In the Haskell world, library packages +expose a set of Haskell modules as their public interface. Cabal +packages can contain a library or executables or both. + +Some programming languages have packages as a builtin language concept. +For example in Java, a package provides a local namespace for types and +other definitions. In the Haskell world, packages are not a part of the +language itself. Haskell programs consist of a number of modules, and +packages just provide a way to partition the modules into sets of +related functionality. Thus the choice of module names in Haskell is +still important, even when using packages. + +### Package names and versions ### + +All packages have a name, e.g. "HUnit". Package names are assumed to be +unique. Cabal package names can use letters, numbers and hyphens, but +not spaces. The namespace for Cabal packages is flat, not hierarchical. + +Packages also have a version, e.g "1.1". This matches the typical way in +which packages are developed. Strictly speaking, each version of a +package is independent, but usually they are very similar. Cabal package +versions follow the conventional numeric style, consisting of a sequence +of digits such as "1.0.1" or "2.0". There are a range of common +conventions for "versioning" packages, that is giving some meaning to +the version number in terms of changes in the package. Section [TODO] +has some tips on package versioning. + +The combination of package name and version is called the _package ID_ +and is written with a hyphen to separate the name and version, e.g. +"HUnit-1.1". + +For Cabal packages, the combination of the package name and version +_uniquely_ identifies each package. Or to put it another way: two +packages with the same name and version are considered to _be_ the same. + +Strictly speaking, the package ID only identifies each Cabal _source_ +package; the same Cabal source package can be configured and built in +different ways. There is a separate installed package ID that uniquely +identifies each installed package instance. Most of the time however, +users need not be aware of this detail. + +### Kinds of package: Cabal vs GHC vs system ### + +It can be slightly confusing at first because there are various +different notions of package floating around. Fortunately the details +are not very complicated. + +Cabal packages +: Cabal packages are really source packages. That is they contain + Haskell (and sometimes C) source code. + + Cabal packages can be compiled to produce GHC packages. They can + also be translated into operating system packages. + +GHC packages +: This is GHC's view on packages. GHC only cares about library + packages, not executables. Library packages have to be registered + with GHC for them to be available in GHCi or to be used when + compiling other programs or packages. + + The low-level tool `ghc-pkg` is used to register GHC packages and to + get information on what packages are currently registered. + + You never need to make GHC packages manually. When you build and + install a Cabal package containing a library then it gets registered + with GHC automatically. + + Haskell implementations other than GHC have essentially the same + concept of registered packages. For the most part, Cabal hides the + slight differences. + +Operating system packages +: On operating systems like Linux and Mac OS X, the system has a + specific notion of a package and there are tools for installing and + managing packages. + + The Cabal package format is designed to allow Cabal packages to be + translated, mostly-automatically, into operating system packages. + They are usually translated 1:1, that is a single Cabal package + becomes a single system package. + + It is also possible to make Windows installers from Cabal packages, + though this is typically done for a program together with all of its + library dependencies, rather than packaging each library separately. + + +### Unit of distribution ### + +The Cabal package is the unit of distribution. What this means is that +each Cabal package can be distributed on its own in source or binary +form. Of course there may dependencies between packages, but there is +usually a degree of flexibility in which versions of packages can work +together so distributing them independently makes sense. + +It is perhaps easiest to see what being ``the unit of distribution'' +means by contrast to an alternative approach. Many projects are made up +of several interdependent packages and during development these might +all be kept under one common directory tree and be built and tested +together. When it comes to distribution however, rather than +distributing them all together in a single tarball, it is required that +they each be distributed independently in their own tarballs. + +Cabal's approach is to say that if you can specify a dependency on a +package then that package should be able to be distributed +independently. Or to put it the other way round, if you want to +distribute it as a single unit, then it should be a single package. + + +### Explicit dependencies and automatic package management ### + +Cabal takes the approach that all packages dependencies are specified +explicitly and specified in a declarative way. The point is to enable +automatic package management. This means tools like `cabal` can resolve +dependencies and install a package plus all of its dependencies +automatically. Alternatively, it is possible to mechanically (or mostly +mechanically) translate Cabal packages into system packages and let the +system package manager install dependencies automatically. + +It is important to track dependencies accurately so that packages can +reliably be moved from one system to another system and still be able to +build it there. Cabal is therefore relatively strict about specifying +dependencies. For example Cabal's default build system will not even let +code build if it tries to import a module from a package that isn't +listed in the `.cabal` file, even if that package is actually installed. +This helps to ensure that there are no "untracked dependencies" that +could cause the code to fail to build on some other system. + +The explicit dependency approach is in contrast to the traditional +"./configure" approach where instead of specifying dependencies +declaratively, the `./configure` script checks if the dependencies are +present on the system. Some manual work is required to transform a +`./configure` based package into a Linux distribution package (or +similar). This conversion work is usually done by people other than the +package author(s). The practical effect of this is that only the most +popular packages will benefit from automatic package management. Instead, +Cabal forces the original author to specify the dependencies but the +advantage is that every package can benefit from automatic package +management. + +The "./configure" approach tends to encourage packages that adapt +themselves to the environment in which they are built, for example by +disabling optional features so that they can continue to work when a +particular dependency is not available. This approach makes sense in a +world where installing additional dependencies is a tiresome manual +process and so minimising dependencies is important. The automatic +package management view is that packages should just declare what they +need and the package manager will take responsibility for ensuring that +all the dependencies are installed. + +Sometimes of course optional features and optional dependencies do make +sense. Cabal packages can have optional features and varying +dependencies. These conditional dependencies are still specified in a +declarative way however and remain compatible with automatic package +management. The need to remain compatible with automatic package +management means that Cabal's conditional dependencies system is a bit +less flexible than with the "./configure" approach. + +### Portability ### + +One of the purposes of Cabal is to make it easier to build packages on +different platforms (operating systems and CPU architectures), with +different compiler versions and indeed even with different Haskell +implementations. (Yes, there are Haskell implementations other than +GHC!) + +Cabal provides abstractions of features present in different Haskell +implementations and wherever possible it is best to take advantage of +these to increase portability. Where necessary however it is possible to +use specific features of specific implementations. + +For example a package author can list in the package's `.cabal` what +language extensions the code uses. This allows Cabal to figure out if +the language extension is supported by the Haskell implementation that +the user picks. Additionally, certain language extensions such as +Template Haskell require special handling from the build system and by +listing the extension it provides the build system with enough +information to do the right thing. + +Another similar example is linking with foreign libraries. Rather than +specifying GHC flags directly, the package author can list the libraries +that are needed and the build system will take care of using the right +flags for the compiler. Additionally this makes it easier for tools to +discover what system C libraries a package needs, which is useful for +tracking dependencies on system libraries (e.g. when translating into +Linux distribution packages). + +In fact both of these examples fall into the category of explicitly +specifying dependencies. Not all dependencies are other Cabal packages. +Foreign libraries are clearly another kind of dependency. It's also +possible to think of language extensions as dependencies: the package +depends on a Haskell implementation that supports all those extensions. + +Where compiler-specific options are needed however, there is an "escape +hatch" available. The developer can specify implementation-specific +options and more generally there is a configuration mechanism to +customise many aspects of how a package is built depending on the +Haskell implementation, the operating system, computer architecture and +user-specified configuration flags. + + +# Developing packages # + +The Cabal package is the unit of distribution. When installed, its +purpose is to make available: + + * One or more Haskell programs. + + * At most one library, exposing a number of Haskell modules. + +However having both a library and executables in a package does not work +very well; if the executables depend on the library, they must +explicitly list all the modules they directly or indirectly import from +that library. Fortunately, starting with Cabal 1.8.0.4, executables can +also declare the package that they are in as a dependency, and Cabal +will treat them as if they were in another package that depended on +the library. + +Internally, the package may consist of much more than a bunch of Haskell +modules: it may also have C source code and header files, source code +meant for preprocessing, documentation, test cases, auxiliary tools etc. + +A package is identified by a globally-unique _package name_, which +consists of one or more alphanumeric words separated by hyphens. To +avoid ambiguity, each of these words should contain at least one letter. +Chaos will result if two distinct packages with the same name are +installed on the same system. A particular version of the package is +distinguished by a _version number_, consisting of a sequence of one or +more integers separated by dots. These can be combined to form a single +text string called the _package ID_, using a hyphen to separate the name +from the version, e.g. "`HUnit-1.1`". + +Note: Packages are not part of the Haskell language; they simply +populate the hierarchical space of module names. In GHC 6.6 and later a +program may contain multiple modules with the same name if they come +from separate packages; in all other current Haskell systems packages +may not overlap in the modules they provide, including hidden modules. + + +## Creating a package ## + +Suppose you have a directory hierarchy containing the source files that +make up your package. You will need to add two more files to the root +directory of the package: + +_package_`.cabal` + +: a Unicode UTF-8 text file containing a package description. + For details of the syntax of this file, see the [section on package + descriptions](#package-descriptions). + +`Setup.hs` + +: a single-module Haskell program to perform various setup tasks (with + the interface described in the section on [building and installing + packages](installing-packages.html). This module should + import only modules that will be present in all Haskell + implementations, including modules of the Cabal library. The + content of this file is determined by the `build-type` setting in + the `.cabal` file. In most cases it will be trivial, calling on + the Cabal library to do most of the work. + +Once you have these, you can create a source bundle of this directory +for distribution. Building of the package is discussed in the section on +[building and installing packages](installing-packages.html). + +One of the purposes of Cabal is to make it easier to build a package +with different Haskell implementations. So it provides abstractions of +features present in different Haskell implementations and wherever +possible it is best to take advantage of these to increase portability. +Where necessary however it is possible to use specific features of +specific implementations. For example one of the pieces of information a +package author can put in the package's `.cabal` file is what language +extensions the code uses. This is far preferable to specifying flags for +a specific compiler as it allows Cabal to pick the right flags for the +Haskell implementation that the user picks. It also allows Cabal to +figure out if the language extension is even supported by the Haskell +implementation that the user picks. Where compiler-specific options are +needed however, there is an "escape hatch" available. The developer can +specify implementation-specific options and more generally there is a +configuration mechanism to customise many aspects of how a package is +built depending on the Haskell implementation, the Operating system, +computer architecture and user-specified configuration flags. + +~~~~~~~~~~~~~~~~ +name: Foo +version: 1.0 + +library + build-depends: base + exposed-modules: Foo + extensions: ForeignFunctionInterface + ghc-options: -Wall + if os(windows) + build-depends: Win32 +~~~~~~~~~~~~~~~~ + +#### Example: A package containing a simple library #### + +The HUnit package contains a file `HUnit.cabal` containing: + +~~~~~~~~~~~~~~~~ +name: HUnit +version: 1.1.1 +synopsis: A unit testing framework for Haskell +homepage: http://hunit.sourceforge.net/ +category: Testing +author: Dean Herington +license: BSD3 +license-file: LICENSE +cabal-version: >= 1.10 +build-type: Simple + +library + build-depends: base >= 2 && < 4 + exposed-modules: Test.HUnit.Base, Test.HUnit.Lang, + Test.HUnit.Terminal, Test.HUnit.Text, Test.HUnit + default-extensions: CPP +~~~~~~~~~~~~~~~~ + +and the following `Setup.hs`: + +~~~~~~~~~~~~~~~~ +import Distribution.Simple +main = defaultMain +~~~~~~~~~~~~~~~~ + +#### Example: A package containing executable programs #### + +~~~~~~~~~~~~~~~~ +name: TestPackage +version: 0.0 +synopsis: Small package with two programs +author: Angela Author +license: BSD3 +build-type: Simple +cabal-version: >= 1.2 + +executable program1 + build-depends: HUnit + main-is: Main.hs + hs-source-dirs: prog1 + +executable program2 + main-is: Main.hs + build-depends: HUnit + hs-source-dirs: prog2 + other-modules: Utils +~~~~~~~~~~~~~~~~ + +with `Setup.hs` the same as above. + +#### Example: A package containing a library and executable programs #### + +~~~~~~~~~~~~~~~~ +name: TestPackage +version: 0.0 +synopsis: Package with library and two programs +license: BSD3 +author: Angela Author +build-type: Simple +cabal-version: >= 1.2 + +library + build-depends: HUnit + exposed-modules: A, B, C + +executable program1 + main-is: Main.hs + hs-source-dirs: prog1 + other-modules: A, B + +executable program2 + main-is: Main.hs + hs-source-dirs: prog2 + other-modules: A, C, Utils +~~~~~~~~~~~~~~~~ + +with `Setup.hs` the same as above. Note that any library modules +required (directly or indirectly) by an executable must be listed again. + +The trivial setup script used in these examples uses the _simple build +infrastructure_ provided by the Cabal library (see +[Distribution.Simple][dist-simple]). The simplicity lies in its +interface rather that its implementation. It automatically handles +preprocessing with standard preprocessors, and builds packages for all +the Haskell implementations. + +The simple build infrastructure can also handle packages where building +is governed by system-dependent parameters, if you specify a little more +(see the section on [system-dependent +parameters](#system-dependent-parameters)). A few packages require [more +elaborate solutions](#more-complex-packages). + +## Package descriptions ## + +The package description file must have a name ending in "`.cabal`". It +must be a Unicode text file encoded using valid UTF-8. There must be +exactly one such file in the directory. The first part of the name is +usually the package name, and some of the tools that operate on Cabal +packages require this. + +In the package description file, lines whose first non-whitespace characters +are "`--`" are treated as comments and ignored. + +This file should contain of a number global property descriptions and +several sections. + +* The [global properties](#package-properties) describe the package as a + whole, such as name, license, author, etc. + +* Optionally, a number of _configuration flags_ can be declared. These + can be used to enable or disable certain features of a package. (see + the section on [configurations](#configurations)). + +* The (optional) library section specifies the [library + properties](#library) and relevant [build + information](#build-information). + +* Following is an arbitrary number of executable sections + which describe an executable program and relevant [build + information](#build-information). + +Each section consists of a number of property descriptions +in the form of field/value pairs, with a syntax roughly like mail +message headers. + +* Case is not significant in field names, but is significant in field + values. + +* To continue a field value, indent the next line relative to the field + name. + +* Field names may be indented, but all field values in the same section + must use the same indentation. + +* Tabs are *not* allowed as indentation characters due to a missing + standard interpretation of tab width. + +* To get a blank line in a field value, use an indented "`.`" + +The syntax of the value depends on the field. Field types include: + +_token_, _filename_, _directory_ +: Either a sequence of one or more non-space non-comma characters, or + a quoted string in Haskell 98 lexical syntax. Unless otherwise + stated, relative filenames and directories are interpreted from the + package root directory. + +_freeform_, _URL_, _address_ +: An arbitrary, uninterpreted string. + +_identifier_ +: A letter followed by zero or more alphanumerics or underscores. + +_compiler_ +: A compiler flavor (one of: `GHC`, `JHC`, `UHC` or `LHC`) followed by a + version range. For example, `GHC ==6.10.3`, or `LHC >=0.6 && <0.8`. + +### Modules and preprocessors ### + +Haskell module names listed in the `exposed-modules` and `other-modules` +fields may correspond to Haskell source files, i.e. with names ending in +"`.hs`" or "`.lhs`", or to inputs for various Haskell preprocessors. The +simple build infrastructure understands the extensions: + +* `.gc` ([greencard][]) +* `.chs` ([c2hs][]) +* `.hsc` (`hsc2hs`) +* `.y` and `.ly` ([happy][]) +* `.x` ([alex][]) +* `.cpphs` ([cpphs][]) + +When building, Cabal will automatically run the appropriate preprocessor +and compile the Haskell module it produces. + +Some fields take lists of values, which are optionally separated by commas, +except for the `build-depends` field, where the commas are mandatory. + +Some fields are marked as required. All others are optional, and unless +otherwise specified have empty default values. + +### Package properties ### + +These fields may occur in the first top-level properties section and +describe the package as a whole: + +`name:` _package-name_ (required) +: The unique name of the package, without the version number. + +`version:` _numbers_ (required) +: The package version number, usually consisting of a sequence of + natural numbers separated by dots. + +`cabal-version:` _>= x.y_ +: The version of the Cabal specification that this package description uses. + The Cabal specification does slowly evolve, introducing new features and + occasionally changing the meaning of existing features. By specifying + which version of the spec you are using it enables programs which process + the package description to know what syntax to expect and what each part + means. + + For historical reasons this is always expressed using _>=_ version range + syntax. No other kinds of version range make sense, in particular upper + bounds do not make sense. In future this field will specify just a version + number, rather than a version range. + + The version number you specify will affect both compatibility and + behaviour. Most tools (including the Cabal library and cabal program) + understand a range of versions of the Cabal specification. Older tools + will of course only work with older versions of the Cabal specification. + Most of the time, tools that are too old will recognise this fact and + produce a suitable error message. + + As for behaviour, new versions of the Cabal spec can change the meaning + of existing syntax. This means if you want to take advantage of the new + meaning or behaviour then you must specify the newer Cabal version. + Tools are expected to use the meaning and behaviour appropriate to the + version given in the package description. + + In particular, the syntax of package descriptions changed significantly + with Cabal version 1.2 and the `cabal-version` field is now required. + Files written in the old syntax are still recognized, so if you require + compatibility with very old Cabal versions then you may write your package + description file using the old syntax. Please consult the user's guide of + an older Cabal version for a description of that syntax. + +`build-type:` _identifier_ +: The type of build used by this package. Build types are the + constructors of the [BuildType][] type, defaulting to `Custom`. + + If the build type is anything other than `Custom`, then the + `Setup.hs` file *must* be exactly the standardized content + discussed below. This is because in these cases, `cabal` will + ignore the `Setup.hs` file completely, whereas other methods of + package management, such as `runhaskell Setup.hs [CMD]`, still + rely on the `Setup.hs` file. + + For build type `Simple`, the contents of `Setup.hs` must be: + + ~~~~~~~~~~~~~~~~ + import Distribution.Simple + main = defaultMain + ~~~~~~~~~~~~~~~~ + + For build type `Configure` (see the section on [system-dependent + parameters](#system-dependent-parameters) below), the contents of + `Setup.hs` must be: + + ~~~~~~~~~~~~~~~~ + import Distribution.Simple + main = defaultMainWithHooks autoconfUserHooks + ~~~~~~~~~~~~~~~~ + + For build type `Make` (see the section on [more complex + packages](installing-packages.html#more-complex-packages) below), + the contents of `Setup.hs` must be: + + ~~~~~~~~~~~~~~~~ + import Distribution.Make + main = defaultMain + ~~~~~~~~~~~~~~~~ + + For build type `Custom`, the file `Setup.hs` can be customized, + and will be used both by `cabal` and other tools. + + For most packages, the build type `Simple` is sufficient. + +`license:` _identifier_ (default: `AllRightsReserved`) +: The type of license under which this package is distributed. + License names are the constants of the [License][dist-license] type. + +`license-file:` _filename_ or `license-files:` _filename list_ +: The name of a file(s) containing the precise copyright license for + this package. The license file(s) will be installed with the package. + + If you have multiple license files then use the `license-files` + field instead of (or in addition to) the `license-file` field. + +`copyright:` _freeform_ +: The content of a copyright notice, typically the name of the holder + of the copyright on the package and the year(s) from which copyright + is claimed. For example: `Copyright: (c) 2006-2007 Joe Bloggs` + +`author:` _freeform_ +: The original author of the package. + + Remember that `.cabal` files are Unicode, using the UTF-8 encoding. + +`maintainer:` _address_ +: The current maintainer or maintainers of the package. This is an e-mail address to which users should send bug + reports, feature requests and patches. + +`stability:` _freeform_ +: The stability level of the package, e.g. `alpha`, `experimental`, `provisional`, + `stable`. + +`homepage:` _URL_ +: The package homepage. + +`bug-reports:` _URL_ +: The URL where users should direct bug reports. This would normally be either: + + * A `mailto:` URL, e.g. for a person or a mailing list. + + * An `http:` (or `https:`) URL for an online bug tracking system. + + For example Cabal itself uses a web-based bug tracking system + + ~~~~~~~~~~~~~~~~ + bug-reports: http://hackage.haskell.org/trac/hackage/ + ~~~~~~~~~~~~~~~~ + +`package-url:` _URL_ +: The location of a source bundle for the package. The distribution + should be a Cabal package. + +`synopsis:` _freeform_ +: A very short description of the package, for use in a table of + packages. This is your headline, so keep it short (one line) but as + informative as possible. Save space by not including the package + name or saying it's written in Haskell. + +`description:` _freeform_ +: Description of the package. This may be several paragraphs, and + should be aimed at a Haskell programmer who has never heard of your + package before. + + For library packages, this field is used as prologue text by [`setup + haddock`](installing-packages.html#setup-haddock), and thus may + contain the same markup as [haddock][] documentation comments. + +`category:` _freeform_ +: A classification category for future use by the package catalogue [Hackage]. These + categories have not yet been specified, but the upper levels of the + module hierarchy make a good start. + +`tested-with:` _compiler list_ +: A list of compilers and versions against which the package has been + tested (or at least built). + +`data-files:` _filename list_ +: A list of files to be installed for run-time use by the package. + This is useful for packages that use a large amount of static data, + such as tables of values or code templates. Cabal provides a way to + [find these files at + run-time](#accessing-data-files-from-package-code). + + A limited form of `*` wildcards in file names, for example + `data-files: images/*.png` matches all the `.png` files in the + `images` directory. + + The limitation is that `*` wildcards are only allowed in place of + the file name, not in the directory name or file extension. In + particular, wildcards do not include directories contents + recursively. Furthermore, if a wildcard is used it must be used with + an extension, so `data-files: data/*` is not allowed. When matching + a wildcard plus extension, a file's full extension must match + exactly, so `*.gz` matches `foo.gz` but not `foo.tar.gz`. A wildcard + that does not match any files is an error. + + The reason for providing only a very limited form of wildcard is to + concisely express the common case of a large number of related files + of the same file type without making it too easy to accidentally + include unwanted files. + +`data-dir:` _directory_ +: The directory where Cabal looks for data files to install, relative + to the source directory. By default, Cabal will look in the source + directory itself. + +`extra-source-files:` _filename list_ +: A list of additional files to be included in source distributions + built with [`setup sdist`](installing-packages.html#setup-sdist). As + with `data-files` it can use a limited form of `*` wildcards in file + names. + +`extra-doc-files:` _filename list_ +: A list of additional files to be included in source distributions, + and also copied to the html directory when Haddock documentation is + generated. As with `data-files` it can use a limited form of `*` + wildcards in file names. + +`extra-tmp-files:` _filename list_ +: A list of additional files or directories to be removed by [`setup + clean`](installing-packages.html#setup-clean). These would typically + be additional files created by additional hooks, such as the scheme + described in the section on [system-dependent + parameters](#system-dependent-parameters). + +### Library ### + +The library section should contain the following fields: + +`exposed-modules:` _identifier list_ (required if this package contains a library) +: A list of modules added by this package. + +`exposed:` _boolean_ (default: `True`) +: Some Haskell compilers (notably GHC) support the notion of packages + being "exposed" or "hidden" which means the modules they provide can + be easily imported without always having to specify which package + they come from. However this only works effectively if the modules + provided by all exposed packages do not overlap (otherwise a module + import would be ambiguous). + + Almost all new libraries use hierarchical module names that do not + clash, so it is very uncommon to have to use this field. However it + may be necessary to set `exposed: False` for some old libraries that + use a flat module namespace or where it is known that the exposed + modules would clash with other common modules. + +`reexported-modules:` _exportlist _ +: Supported only in GHC 7.10 and later. A list of modules to _reexport_ from + this package. The syntax of this field is `orig-pkg:Name as NewName` to + reexport module `Name` from `orig-pkg` with the new name `NewName`. We also + support abbreviated versions of the syntax: if you omit `as NewName`, + we'll reexport without renaming; if you omit `orig-pkg`, then we will + automatically figure out which package to reexport from, if it's + unambiguous. + + Reexported modules are useful for compatibility shims when a package has + been split into multiple packages, and they have the useful property that + if a package provides a module, and another package reexports it under + the same name, these are not considered a conflict (as would be the case + with a stub module.) They can also be used to resolve name conflicts. + +The library section may also contain build information fields (see the +section on [build information](#build-information)). + +#### Opening an interpreter session #### + +While developing a package, it is often useful to make its code available inside +an interpreter session. This can be done with the `repl` command: + +~~~~~~~~~~~~~~~~ +cabal repl +~~~~~~~~~~~~~~~~ + +The name comes from the acronym [REPL], which stands for +"read-eval-print-loop". By default `cabal repl` loads the first component in a +package. If the package contains several named components, the name can be given +as an argument to `repl`. The name can be also optionally prefixed with the +component's type for disambiguation purposes. Example: + +~~~~~~~~~~~~~~~~ +cabal repl foo +cabal repl exe:foo +cabal repl test:bar +cabal repl bench:baz +~~~~~~~~~~~~~~~~ + +#### Freezing dependency versions #### + +If a package is built in several different environments, such as a development +environment, a staging environment and a production environment, it may be +necessary or desirable to ensure that the same dependency versions are +selected in each environment. This can be done with the `freeze` command: + +~~~~~~~~~~~~~~~~ +cabal freeze +~~~~~~~~~~~~~~~~ + +The command writes the selected version for all dependencies to the +`cabal.config` file. All environments which share this file will use the +dependency versions specified in it. + +### Executables ### + +Executable sections (if present) describe executable programs contained +in the package and must have an argument after the section label, which +defines the name of the executable. This is a freeform argument but may +not contain spaces. + +The executable may be described using the following fields, as well as +build information fields (see the section on [build +information](#build-information)). + +`main-is:` _filename_ (required) +: The name of the `.hs` or `.lhs` file containing the `Main` module. Note that it is the + `.hs` filename that must be listed, even if that file is generated + using a preprocessor. The source file must be relative to one of the + directories listed in `hs-source-dirs`. + +#### Running executables #### + +You can have Cabal build and run your executables by using the `run` command: + +~~~~~~~~~~~~~~~~ +$ cabal run EXECUTABLE [-- EXECUTABLE_FLAGS] +~~~~~~~~~~~~~~~~ + +This command will configure, build and run the executable `EXECUTABLE`. The +double dash separator is required to distinguish executable flags from `run`'s +own flags. If there is only one executable defined in the whole package, the +executable's name can be omitted. See the output of `cabal help run` for a list +of options you can pass to `cabal run`. + + +### Test suites ### + +Test suite sections (if present) describe package test suites and must have an +argument after the section label, which defines the name of the test suite. +This is a freeform argument, but may not contain spaces. It should be unique +among the names of the package's other test suites, the package's executables, +and the package itself. Using test suite sections requires at least Cabal +version 1.9.2. + +The test suite may be described using the following fields, as well as build +information fields (see the section on [build +information](#build-information)). + +`type:` _interface_ (required) +: The interface type and version of the test suite. Cabal supports two test + suite interfaces, called `exitcode-stdio-1.0` and `detailed-0.9`. Each of + these types may require or disallow other fields as described below. + +Test suites using the `exitcode-stdio-1.0` interface are executables +that indicate test failure with a non-zero exit code when run; they may provide +human-readable log information through the standard output and error channels. +This interface is provided primarily for compatibility with existing test +suites; it is preferred that new test suites be written for the `detailed-0.9` +interface. The `exitcode-stdio-1.0` type requires the `main-is` field. + +`main-is:` _filename_ (required: `exitcode-stdio-1.0`, disallowed: `detailed-0.9`) +: The name of the `.hs` or `.lhs` file containing the `Main` module. Note that it is the + `.hs` filename that must be listed, even if that file is generated + using a preprocessor. The source file must be relative to one of the + directories listed in `hs-source-dirs`. This field is analogous to the + `main-is` field of an executable section. + +Test suites using the `detailed-0.9` interface are modules exporting the symbol +`tests :: IO [Test]`. The `Test` type is exported by the module +`Distribution.TestSuite` provided by Cabal. For more details, see the example below. + +The `detailed-0.9` interface allows Cabal and other test agents to inspect a +test suite's results case by case, producing detailed human- and +machine-readable log files. The `detailed-0.9` interface requires the +`test-module` field. + +`test-module:` _identifier_ (required: `detailed-0.9`, disallowed: `exitcode-stdio-1.0`) +: The module exporting the `tests` symbol. + +#### Example: Package using `exitcode-stdio-1.0` interface #### + +The example package description and executable source file below demonstrate +the use of the `exitcode-stdio-1.0` interface. For brevity, the example package +does not include a library or any normal executables, but a real package would +be required to have at least one library or executable. + +foo.cabal: + +~~~~~~~~~~~~~~~~ +Name: foo +Version: 1.0 +License: BSD3 +Cabal-Version: >= 1.9.2 +Build-Type: Simple + +Test-Suite test-foo + type: exitcode-stdio-1.0 + main-is: test-foo.hs + build-depends: base +~~~~~~~~~~~~~~~~ + +test-foo.hs: + +~~~~~~~~~~~~~~~~ +module Main where + +import System.Exit (exitFailure) + +main = do + putStrLn "This test always fails!" + exitFailure +~~~~~~~~~~~~~~~~ + +#### Example: Package using `detailed-0.9` interface #### + +The example package description and test module source file below demonstrate +the use of the `detailed-0.9` interface. For brevity, the example package does +note include a library or any normal executables, but a real package would be +required to have at least one library or executable. The test module below +also develops a simple implementation of the interface set by +`Distribution.TestSuite`, but in actual usage the implementation would be +provided by the library that provides the testing facility. + +bar.cabal: + +~~~~~~~~~~~~~~~~ +Name: bar +Version: 1.0 +License: BSD3 +Cabal-Version: >= 1.9.2 +Build-Type: Simple + +Test-Suite test-bar + type: detailed-0.9 + test-module: Bar + build-depends: base, Cabal >= 1.9.2 +~~~~~~~~~~~~~~~~ + +Bar.hs: + +~~~~~~~~~~~~~~~~ +module Bar ( tests ) where + +import Distribution.TestSuite + +tests :: IO [Test] +tests = return [ Test succeeds, Test fails ] + where + succeeds = TestInstance + { run = return $ Finished Pass + , name = "succeeds" + , tags = [] + , options = [] + , setOption = \_ _ -> Right succeeds + } + fails = TestInstance + { run = return $ Finished $ Fail "Always fails!" + , name = "fails" + , tags = [] + , options = [] + , setOption = \_ _ -> Right fails + } +~~~~~~~~~~~~~~~~ + +#### Running test suites #### + +You can have Cabal run your test suites using its built-in test +runner: + +~~~~~~~~~~~~~~~~ +$ cabal configure --enable-tests +$ cabal build +$ cabal test +~~~~~~~~~~~~~~~~ + +See the output of `cabal help test` for a list of options you can pass +to `cabal test`. + +### Benchmarks ### + +Benchmark sections (if present) describe benchmarks contained in the package and +must have an argument after the section label, which defines the name of the +benchmark. This is a freeform argument, but may not contain spaces. It should +be unique among the names of the package's other benchmarks, the package's test +suites, the package's executables, and the package itself. Using benchmark +sections requires at least Cabal version 1.9.2. + +The benchmark may be described using the following fields, as well as build +information fields (see the section on [build information](#build-information)). + +`type:` _interface_ (required) +: The interface type and version of the benchmark. At the moment Cabal only + support one benchmark interface, called `exitcode-stdio-1.0`. + +Benchmarks using the `exitcode-stdio-1.0` interface are executables that +indicate failure to run the benchmark with a non-zero exit code when run; they +may provide human-readable information through the standard output and error +channels. + +`main-is:` _filename_ (required: `exitcode-stdio-1.0`) +: The name of the `.hs` or `.lhs` file containing the `Main` module. Note that + it is the `.hs` filename that must be listed, even if that file is generated + using a preprocessor. The source file must be relative to one of the + directories listed in `hs-source-dirs`. This field is analogous to the + `main-is` field of an executable section. + +#### Example: Package using `exitcode-stdio-1.0` interface #### + +The example package description and executable source file below demonstrate +the use of the `exitcode-stdio-1.0` interface. For brevity, the example package +does not include a library or any normal executables, but a real package would +be required to have at least one library or executable. + +foo.cabal: + +~~~~~~~~~~~~~~~~ +Name: foo +Version: 1.0 +License: BSD3 +Cabal-Version: >= 1.9.2 +Build-Type: Simple + +Benchmark bench-foo + type: exitcode-stdio-1.0 + main-is: bench-foo.hs + build-depends: base, time +~~~~~~~~~~~~~~~~ + +bench-foo.hs: + +~~~~~~~~~~~~~~~~ +{-# LANGUAGE BangPatterns #-} +module Main where + +import Data.Time.Clock + +fib 0 = 1 +fib 1 = 1 +fib n = fib (n-1) + fib (n-2) + +main = do + start <- getCurrentTime + let !r = fib 20 + end <- getCurrentTime + putStrLn $ "fib 20 took " ++ show (diffUTCTime end start) +~~~~~~~~~~~~~~~~ + +#### Running benchmarks #### + +You can have Cabal run your benchmark using its built-in benchmark runner: + +~~~~~~~~~~~~~~~~ +$ cabal configure --enable-benchmarks +$ cabal build +$ cabal bench +~~~~~~~~~~~~~~~~ + +See the output of `cabal help bench` for a list of options you can +pass to `cabal bench`. + +### Build information ### + +The following fields may be optionally present in a library or +executable section, and give information for the building of the +corresponding library or executable. See also the sections on +[system-dependent parameters](#system-dependent-parameters) and +[configurations](#configurations) for a way to supply system-dependent +values for these fields. + +`build-depends:` _package list_ +: A list of packages needed to build this one. Each package can be + annotated with a version constraint. + + Version constraints use the operators `==, >=, >, <, <=` and a + version number. Multiple constraints can be combined using `&&` or + `||`. If no version constraint is specified, any version is assumed + to be acceptable. For example: + + ~~~~~~~~~~~~~~~~ + library + build-depends: + base >= 2, + foo >= 1.2 && < 1.3, + bar + ~~~~~~~~~~~~~~~~ + + Dependencies like `foo >= 1.2 && < 1.3` turn out to be very common + because it is recommended practise for package versions to + correspond to API versions. As of Cabal 1.6, there is a special + syntax to support this use: + + ~~~~~~~~~~~~~~~~ + build-depends: foo ==1.2.* + ~~~~~~~~~~~~~~~~ + + It is only syntactic sugar. It is exactly equivalent to `foo >= 1.2 && < 1.3`. + + With Cabal 1.20 and GHC 7.10, `build-depends` also supports module + thinning and renaming, which allows you to selectively decide what + modules become visible from a package dependency. For example: + + ~~~~~~~~~~~~~~~~ + build-depends: containers (Data.Set, Data.IntMap as Map) + ~~~~~~~~~~~~~~~~ + + This results in only the modules `Data.Set` and `Map` being visible to + the user from containers, hiding all other modules. To add additional + names for modules without hiding the others, you can use the `with` + keyword: + + ~~~~~~~~~~~~~~~~ + build-depends: containers with (Data.IntMap as Map) + ~~~~~~~~~~~~~~~~ + + Note: Prior to Cabal 1.8, build-depends specified in each section + were global to all sections. This was unintentional, but some packages + were written to depend on it, so if you need your build-depends to + be local to each section, you must specify at least + `Cabal-Version: >= 1.8` in your `.cabal` file. + +`other-modules:` _identifier list_ +: A list of modules used by the component but not exposed to users. + For a library component, these would be hidden modules of the + library. For an executable, these would be auxiliary modules to be + linked with the file named in the `main-is` field. + + Note: Every module in the package *must* be listed in one of + `other-modules`, `exposed-modules` or `main-is` fields. + +`hs-source-dirs:` _directory list_ (default: "`.`") +: Root directories for the module hierarchy. + + For backwards compatibility, the old variant `hs-source-dir` is also + recognized. + +`extensions:` _identifier list_ +: A list of Haskell extensions used by every module. Extension names + are the constructors of the [Extension][extension] type. These + determine corresponding compiler options. In particular, `CPP` specifies that + Haskell source files are to be preprocessed with a C preprocessor. + + Extensions used only by one module may be specified by placing a + `LANGUAGE` pragma in the source file affected, e.g.: + + ~~~~~~~~~~~~~~~~ + {-# LANGUAGE CPP, MultiParamTypeClasses #-} + ~~~~~~~~~~~~~~~~ + + Note: GHC versions prior to 6.6 do not support the `LANGUAGE` pragma. + +`build-tools:` _program list_ +: A list of programs, possibly annotated with versions, needed to + build this package, e.g. `c2hs >= 0.15, cpphs`.If no version + constraint is specified, any version is assumed to be acceptable. + +`buildable:` _boolean_ (default: `True`) +: Is the component buildable? Like some of the other fields below, + this field is more useful with the slightly more elaborate form of + the simple build infrastructure described in the section on + [system-dependent parameters](#system-dependent-parameters). + +`ghc-options:` _token list_ +: Additional options for GHC. You can often achieve the same effect + using the `extensions` field, which is preferred. + + Options required only by one module may be specified by placing an + `OPTIONS_GHC` pragma in the source file affected. + +`ghc-prof-options:` _token list_ +: Additional options for GHC when the package is built with profiling + enabled. + +`ghc-shared-options:` _token list_ +: Additional options for GHC when the package is built as shared library. + +`includes:` _filename list_ +: A list of header files to be included in any compilations via C. + This field applies to both header files that are already installed + on the system and to those coming with the package to be installed. + These files typically contain function prototypes for foreign + imports used by the package. + +`install-includes:` _filename list_ +: A list of header files from this package to be installed into + `$libdir/includes` when the package is installed. Files listed in + `install-includes:` should be found in relative to the top of the + source tree or relative to one of the directories listed in + `include-dirs`. + + `install-includes` is typically used to name header files that + contain prototypes for foreign imports used in Haskell code in this + package, for which the C implementations are also provided with the + package. Note that to include them when compiling the package + itself, they need to be listed in the `includes:` field as well. + +`include-dirs:` _directory list_ +: A list of directories to search for header files, when preprocessing + with `c2hs`, `hsc2hs`, `cpphs` or the C preprocessor, and + also when compiling via C. + +`c-sources:` _filename list_ +: A list of C source files to be compiled and linked with the Haskell files. + +`js-sources:` _filename list_ +: A list of JavaScript source files to be linked with the Haskell files + (only for JavaScript targets). + +`extra-libraries:` _token list_ +: A list of extra libraries to link with. + +`extra-ghci-libraries:` _token list_ +: A list of extra libraries to be used instead of 'extra-libraries' when + the package is loaded with GHCi. + +`extra-lib-dirs:` _directory list_ +: A list of directories to search for libraries. + +`cc-options:` _token list_ +: Command-line arguments to be passed to the C compiler. Since the + arguments are compiler-dependent, this field is more useful with the + setup described in the section on [system-dependent + parameters](#system-dependent-parameters). + +`cpp-options:` _token list_ +: Command-line arguments for pre-processing Haskell code. Applies to + haskell source and other pre-processed Haskell source like .hsc .chs. + Does not apply to C code, that's what cc-options is for. + +`ld-options:` _token list_ +: Command-line arguments to be passed to the linker. Since the + arguments are compiler-dependent, this field is more useful with the + setup described in the section on [system-dependent + parameters](#system-dependent-parameters)>. + +`pkgconfig-depends:` _package list_ +: A list of [pkg-config][] packages, needed to build this package. + They can be annotated with versions, e.g. `gtk+-2.0 >= 2.10, cairo + >= 1.0`. If no version constraint is specified, any version is + assumed to be acceptable. Cabal uses `pkg-config` to find if the + packages are available on the system and to find the extra + compilation and linker options needed to use the packages. + + If you need to bind to a C library that supports `pkg-config` (use + `pkg-config --list-all` to find out if it is supported) then it is + much preferable to use this field rather than hard code options into + the other fields. + +`frameworks:` _token list_ +: On Darwin/MacOS X, a list of frameworks to link to. See Apple's + developer documentation for more details on frameworks. This entry + is ignored on all other platforms. + +### Configurations ### + +Library and executable sections may include conditional +blocks, which test for various system parameters and +configuration flags. The flags mechanism is rather generic, +but most of the time a flag represents certain feature, that +can be switched on or off by the package user. +Here is an example package description file using +configurations: + +#### Example: A package containing a library and executable programs #### + +~~~~~~~~~~~~~~~~ +Name: Test1 +Version: 0.0.1 +Cabal-Version: >= 1.2 +License: BSD3 +Author: Jane Doe +Synopsis: Test package to test configurations +Category: Example + +Flag Debug + Description: Enable debug support + Default: False + +Flag WebFrontend + Description: Include API for web frontend. + -- Cabal checks if the configuration is possible, first + -- with this flag set to True and if not it tries with False + +Library + Build-Depends: base + Exposed-Modules: Testing.Test1 + Extensions: CPP + + if flag(debug) + GHC-Options: -DDEBUG + if !os(windows) + CC-Options: "-DDEBUG" + else + CC-Options: "-DNDEBUG" + + if flag(webfrontend) + Build-Depends: cgi > 0.42 + Other-Modules: Testing.WebStuff + +Executable test1 + Main-is: T1.hs + Other-Modules: Testing.Test1 + Build-Depends: base + + if flag(debug) + CC-Options: "-DDEBUG" + GHC-Options: -DDEBUG +~~~~~~~~~~~~~~~~ + +#### Layout #### + +Flags, conditionals, library and executable sections use layout to +indicate structure. This is very similar to the Haskell layout rule. +Entries in a section have to all be indented to the same level which +must be more than the section header. Tabs are not allowed to be used +for indentation. + +As an alternative to using layout you can also use explicit braces `{}`. +In this case the indentation of entries in a section does not matter, +though different fields within a block must be on different lines. Here +is a bit of the above example again, using braces: + +#### Example: Using explicit braces rather than indentation for layout #### + +~~~~~~~~~~~~~~~~ +Name: Test1 +Version: 0.0.1 +Cabal-Version: >= 1.2 +License: BSD3 +Author: Jane Doe +Synopsis: Test package to test configurations +Category: Example + +Flag Debug { + Description: Enable debug support + Default: False +} + +Library { + Build-Depends: base + Exposed-Modules: Testing.Test1 + Extensions: CPP + if flag(debug) { + GHC-Options: -DDEBUG + if !os(windows) { + CC-Options: "-DDEBUG" + } else { + CC-Options: "-DNDEBUG" + } + } +} +~~~~~~~~~~~~~~~~ + +#### Configuration Flags #### + +A flag section takes the flag name as an argument and may contain the +following fields. + +`description:` _freeform_ +: The description of this flag. + +`default:` _boolean_ (default: `True`) +: The default value of this flag. + + Note that this value may be [overridden in several + ways](installing-packages.html#controlling-flag-assignments"). The + rationale for having flags default to True is that users usually + want new features as soon as they are available. Flags representing + features that are not (yet) recommended for most users (such as + experimental features or debugging support) should therefore + explicitly override the default to False. + +`manual:` _boolean_ (default: `False`) +: By default, Cabal will first try to satisfy dependencies with the + default flag value and then, if that is not possible, with the + negated value. However, if the flag is manual, then the default + value (which can be overridden by commandline flags) will be used. + +#### Conditional Blocks #### + +Conditional blocks may appear anywhere inside a library or executable +section. They have to follow rather strict formatting rules. +Conditional blocks must always be of the shape + +~~~~~~~~~~~~~~~~ + `if `_condition_ + _property-descriptions-or-conditionals*_ +~~~~~~~~~~~~~~~~ + +or + +~~~~~~~~~~~~~~~~ + `if `_condition_ + _property-descriptions-or-conditionals*_ + `else` + _property-descriptions-or-conditionals*_ +~~~~~~~~~~~~~~~~ + +Note that the `if` and the condition have to be all on the same line. + +#### Conditions #### + +Conditions can be formed using boolean tests and the boolean operators +`||` (disjunction / logical "or"), `&&` (conjunction / logical "and"), +or `!` (negation / logical "not"). The unary `!` takes highest +precedence, `||` takes lowest. Precedence levels may be overridden +through the use of parentheses. For example, `os(darwin) && !arch(i386) +|| os(freebsd)` is equivalent to `(os(darwin) && !(arch(i386))) || +os(freebsd)`. + +The following tests are currently supported. + +`os(`_name_`)` +: Tests if the current operating system is _name_. The argument is + tested against `System.Info.os` on the target system. There is + unfortunately some disagreement between Haskell implementations + about the standard values of `System.Info.os`. Cabal canonicalises + it so that in particular `os(windows)` works on all implementations. + If the canonicalised os names match, this test evaluates to true, + otherwise false. The match is case-insensitive. + +`arch(`_name_`)` +: Tests if the current architecture is _name_. The argument is + matched against `System.Info.arch` on the target system. If the arch + names match, this test evaluates to true, otherwise false. The match + is case-insensitive. + +`impl(`_compiler_`)` +: Tests for the configured Haskell implementation. An optional version + constraint may be specified (for example `impl(ghc >= 6.6.1)`). If + the configured implementation is of the right type and matches the + version constraint, then this evaluates to true, otherwise false. + The match is case-insensitive. + +`flag(`_name_`)` +: Evaluates to the current assignment of the flag of the given name. + Flag names are case insensitive. Testing for flags that have not + been introduced with a flag section is an error. + +`true` +: Constant value true. + +`false` +: Constant value false. + +#### Resolution of Conditions and Flags #### + +If a package descriptions specifies configuration flags the package user can +[control these in several ways](installing-packages.html#controlling-flag-assignments). +If the user does not fix the value of a flag, Cabal will try to find a flag +assignment in the following way. + + * For each flag specified, it will assign its default value, evaluate + all conditions with this flag assignment, and check if all + dependencies can be satisfied. If this check succeeded, the package + will be configured with those flag assignments. + + * If dependencies were missing, the last flag (as by the order in + which the flags were introduced in the package description) is tried + with its alternative value and so on. This continues until either + an assignment is found where all dependencies can be satisfied, or + all possible flag assignments have been tried. + +To put it another way, Cabal does a complete backtracking search to find +a satisfiable package configuration. It is only the dependencies +specified in the `build-depends` field in conditional blocks that +determine if a particular flag assignment is satisfiable (`build-tools` +are not considered). The order of the declaration and the default value +of the flags determines the search order. Flags overridden on the +command line fix the assignment of that flag, so no backtracking will be +tried for that flag. + +If no suitable flag assignment could be found, the configuration phase +will fail and a list of missing dependencies will be printed. Note that +this resolution process is exponential in the worst case (i.e., in the +case where dependencies cannot be satisfied). There are some +optimizations applied internally, but the overall complexity remains +unchanged. + +### Meaning of field values when using conditionals ### + +During the configuration phase, a flag assignment is chosen, all +conditionals are evaluated, and the package description is combined into +a flat package descriptions. If the same field both inside a conditional +and outside then they are combined using the following rules. + + + * Boolean fields are combined using conjunction (logical "and"). + + * List fields are combined by appending the inner items to the outer + items, for example + + ~~~~~~~~~~~~~~~~ + Extensions: CPP + if impl(ghc) + Extensions: MultiParamTypeClasses + ~~~~~~~~~~~~~~~~ + + when compiled using GHC will be combined to + + ~~~~~~~~~~~~~~~~ + Extensions: CPP, MultiParamTypeClasses + ~~~~~~~~~~~~~~~~ + + Similarly, if two conditional sections appear at the same nesting + level, properties specified in the latter will come after properties + specified in the former. + + * All other fields must not be specified in ambiguous ways. For + example + + ~~~~~~~~~~~~~~~~ + Main-is: Main.hs + if flag(useothermain) + Main-is: OtherMain.hs + ~~~~~~~~~~~~~~~~ + + will lead to an error. Instead use + + ~~~~~~~~~~~~~~~~ + if flag(useothermain) + Main-is: OtherMain.hs + else + Main-is: Main.hs + ~~~~~~~~~~~~~~~~ + +### Source Repositories ### + +It is often useful to be able to specify a source revision control +repository for a package. Cabal lets you specifying this information in +a relatively structured form which enables other tools to interpret and +make effective use of the information. For example the information +should be sufficient for an automatic tool to checkout the sources. + +Cabal supports specifying different information for various common +source control systems. Obviously not all automated tools will support +all source control systems. + +Cabal supports specifying repositories for different use cases. By +declaring which case we mean automated tools can be more useful. There +are currently two kinds defined: + + * The `head` kind refers to the latest development branch of the + package. This may be used for example to track activity of a project + or as an indication to outside developers what sources to get for + making new contributions. + + * The `this` kind refers to the branch and tag of a repository that + contains the sources for this version or release of a package. For most + source control systems this involves specifying a tag, id or hash of + some form and perhaps a branch. The purpose is to be able to + reconstruct the sources corresponding to a particular package + version. This might be used to indicate what sources to get if + someone needs to fix a bug in an older branch that is no longer an + active head branch. + +You can specify one kind or the other or both. As an example here are +the repositories for the Cabal library. Note that the `this` kind of +repository specifies a tag. + +~~~~~~~~~~~~~~~~ +source-repository head + type: darcs + location: http://darcs.haskell.org/cabal/ + +source-repository this + type: darcs + location: http://darcs.haskell.org/cabal-branches/cabal-1.6/ + tag: 1.6.1 +~~~~~~~~~~~~~~~~ + +The exact fields are as follows: + +`type:` _token_ +: The name of the source control system used for this repository. The + currently recognised types are: + + * `darcs` + * `git` + * `svn` + * `cvs` + * `mercurial` (or alias `hg`) + * `bazaar` (or alias `bzr`) + * `arch` + * `monotone` + + This field is required. + +`location:` _URL_ +: The location of the repository. The exact form of this field depends + on the repository type. For example: + + * for darcs: `http://code.haskell.org/foo/` + * for git: `git://github.com/foo/bar.git` + * for CVS: `anoncvs@cvs.foo.org:/cvs` + + This field is required. + +`module:` _token_ +: CVS requires a named module, as each CVS server can host multiple + named repositories. + + This field is required for the CVS repository type and should not + be used otherwise. + +`branch:` _token_ +: Many source control systems support the notion of a branch, as a + distinct concept from having repositories in separate locations. For + example CVS, SVN and git use branches while for darcs uses different + locations for different branches. If you need to specify a branch to + identify a your repository then specify it in this field. + + This field is optional. + +`tag:` _token_ +: A tag identifies a particular state of a source repository. The tag + can be used with a `this` repository kind to identify the state of + a repository corresponding to a particular package version or + release. The exact form of the tag depends on the repository type. + + This field is required for the `this` repository kind. + +`subdir:` _directory_ +: Some projects put the sources for multiple packages under a single + source repository. This field lets you specify the relative path + from the root of the repository to the top directory for the + package, i.e. the directory containing the package's `.cabal` file. + + This field is optional. It default to empty which corresponds to the + root directory of the repository. + +### Downloading a package's source ### + +The `cabal get` command allows to access a package's source code - either by +unpacking a tarball downloaded from Hackage (the default) or by checking out a +working copy from the package's source repository. + +~~~~~~~~~~~~~~~~ +$ cabal get [FLAGS] PACKAGES +~~~~~~~~~~~~~~~~ + +The `get` command supports the following options: + +`-d --destdir` _PATH_ +: Where to place the package source, defaults to (a subdirectory of) the + current directory. + +`-s --source-repository` _[head|this|...]_ +: Fork the package's source repository using the appropriate version control + system. The optional argument allows to choose a specific repository kind. + + +## Accessing data files from package code ## + +The placement on the target system of files listed in the `data-files` +field varies between systems, and in some cases one can even move +packages around after installation (see [prefix +independence](installing-packages.html#prefix-independence)). To enable +packages to find these files in a portable way, Cabal generates a module +called `Paths_`_pkgname_ (with any hyphens in _pkgname_ replaced by +underscores) during building, so that it may be imported by modules of +the package. This module defines a function + +~~~~~~~~~~~~~~~ +getDataFileName :: FilePath -> IO FilePath +~~~~~~~~~~~~~~~ + +If the argument is a filename listed in the `data-files` field, the +result is the name of the corresponding file on the system on which the +program is running. + +Note: If you decide to import the `Paths_`_pkgname_ module then it +*must* be listed in the `other-modules` field just like any other module +in your package. + +The `Paths_`_pkgname_ module is not platform independent so it does not +get included in the source tarballs generated by `sdist`. + +### Accessing the package version ### + +The aforementioned auto generated `Paths_`_pkgname_ module also +exports the constant `version ::` [Version][data-version] which is +defined as the version of your package as specified in the `version` +field. + +## System-dependent parameters ## + +For some packages, especially those interfacing with C libraries, +implementation details and the build procedure depend on the build +environment. The `build-type` `Configure` can be used to handle many +such situations. In this case, `Setup.hs` should be: + +~~~~~~~~~~~~~~~~ +import Distribution.Simple +main = defaultMainWithHooks autoconfUserHooks +~~~~~~~~~~~~~~~~ + +Most packages, however, would probably do better using the `Simple` +build type and [configurations](#configurations). + +The `build-type` `Configure` differs from `Simple` in two ways: + +* The package root directory must contain a shell script called + `configure`. The configure step will run the script. This `configure` + script may be produced by [autoconf][] or may be hand-written. The + `configure` script typically discovers information about the system + and records it for later steps, e.g. by generating system-dependent + header files for inclusion in C source files and preprocessed Haskell + source files. (Clearly this won't work for Windows without MSYS or + Cygwin: other ideas are needed.) + +* If the package root directory contains a file called + _package_`.buildinfo` after the configuration step, subsequent steps + will read it to obtain additional settings for [build + information](#build-information) fields,to be merged with the ones + given in the `.cabal` file. In particular, this file may be generated + by the `configure` script mentioned above, allowing these settings to + vary depending on the build environment. + + The build information file should have the following structure: + + > _buildinfo_ + > + > `executable:` _name_ + > _buildinfo_ + > + > `executable:` _name_ + > _buildinfo_ + > ... + + where each _buildinfo_ consists of settings of fields listed in the + section on [build information](#build-information). The first one (if + present) relates to the library, while each of the others relate to + the named executable. (The names must match the package description, + but you don't have to have entries for all of them.) + +Neither of these files is required. If they are absent, this setup +script is equivalent to `defaultMain`. + +#### Example: Using autoconf #### + +This example is for people familiar with the [autoconf][] tools. + +In the X11 package, the file `configure.ac` contains: + +~~~~~~~~~~~~~~~~ +AC_INIT([Haskell X11 package], [1.1], [libraries@haskell.org], [X11]) + +# Safety check: Ensure that we are in the correct source directory. +AC_CONFIG_SRCDIR([X11.cabal]) + +# Header file to place defines in +AC_CONFIG_HEADERS([include/HsX11Config.h]) + +# Check for X11 include paths and libraries +AC_PATH_XTRA +AC_TRY_CPP([#include ],,[no_x=yes]) + +# Build the package if we found X11 stuff +if test "$no_x" = yes +then BUILD_PACKAGE_BOOL=False +else BUILD_PACKAGE_BOOL=True +fi +AC_SUBST([BUILD_PACKAGE_BOOL]) + +AC_CONFIG_FILES([X11.buildinfo]) +AC_OUTPUT +~~~~~~~~~~~~~~~~ + +Then the setup script will run the `configure` script, which checks for +the presence of the X11 libraries and substitutes for variables in the +file `X11.buildinfo.in`: + +~~~~~~~~~~~~~~~~ +buildable: @BUILD_PACKAGE_BOOL@ +cc-options: @X_CFLAGS@ +ld-options: @X_LIBS@ +~~~~~~~~~~~~~~~~ + +This generates a file `X11.buildinfo` supplying the parameters needed by +later stages: + +~~~~~~~~~~~~~~~~ +buildable: True +cc-options: -I/usr/X11R6/include +ld-options: -L/usr/X11R6/lib +~~~~~~~~~~~~~~~~ + +The `configure` script also generates a header file `include/HsX11Config.h` +containing C preprocessor defines recording the results of various tests. This +file may be included by C source files and preprocessed Haskell source files in +the package. + +Note: Packages using these features will also need to list additional files such +as `configure`, templates for `.buildinfo` files, files named only in +`.buildinfo` files, header files and so on in the `extra-source-files` field to +ensure that they are included in source distributions. They should also list +files and directories generated by `configure` in the `extra-tmp-files` field to +ensure that they are removed by `setup clean`. + +Quite often the files generated by `configure` need to be listed somewhere in +the package description (for example, in the `install-includes` field). However, +we usually don't want generated files to be included in the source tarball. The +solution is again provided by the `.buildinfo` file. In the above example, the +following line should be added to `X11.buildinfo`: + +~~~~~~~~~~~~~~~~ +install-includes: HsX11Config.h +~~~~~~~~~~~~~~~~ + +In this way, the generated `HsX11Config.h` file won't be included in the source +tarball in addition to `HsX11Config.h.in`, but it will be copied to the right +location during the install process. Packages that use custom `Setup.hs` scripts +can update the necessary fields programmatically instead of using the +`.buildinfo` file. + + +## Conditional compilation ## + +Sometimes you want to write code that works with more than one version +of a dependency. You can specify a range of versions for the dependency +in the `build-depends`, but how do you then write the code that can use +different versions of the API? + +Haskell lets you preprocess your code using the C preprocessor (either +the real C preprocessor, or `cpphs`). To enable this, add `extensions: +CPP` to your package description. When using CPP, Cabal provides some +pre-defined macros to let you test the version of dependent packages; +for example, suppose your package works with either version 3 or version +4 of the `base` package, you could select the available version in your +Haskell modules like this: + +~~~~~~~~~~~~~~~~ +#if MIN_VERSION_base(4,0,0) +... code that works with base-4 ... +#else +... code that works with base-3 ... +#endif +~~~~~~~~~~~~~~~~ + +In general, Cabal supplies a macro `MIN_VERSION_`_`package`_`_(A,B,C)` +for each package depended on via `build-depends`. This macro is true if +the actual version of the package in use is greater than or equal to +`A.B.C` (using the conventional ordering on version numbers, which is +lexicographic on the sequence, but numeric on each component, so for +example 1.2.0 is greater than 1.0.3). + +Since version 1.20, there is also the `MIN_TOOL_VERSION_`_`tool`_ family of +macros for conditioning on the version of build tools used to build the program +(e.g. `hsc2hs`). + +Cabal places the definitions of these macros into an +automatically-generated header file, which is included when +preprocessing Haskell source code by passing options to the C +preprocessor. + +Cabal also allows to detect when the source code is being used for generating +documentation. The `__HADDOCK_VERSION__` macro is defined only when compiling +via [haddock][] instead of a normal Haskell compiler. The value of the +`__HADDOCK_VERSION__` macro is defined as `A*1000 + B*10 + C`, where `A.B.C` is +the Haddock version. This can be useful for working around bugs in Haddock or +generating prettier documentation in some special cases. + +## More complex packages ## + +For packages that don't fit the simple schemes described above, you have +a few options: + + * By using the `build-type` `Custom`, you can supply your own + `Setup.hs` file, and customize the simple build infrastructure + using _hooks_. These allow you to perform additional actions + before and after each command is run, and also to specify + additional preprocessors. A typical `Setup.hs` may look like this: + + ~~~~~~~~~~~~~~~~ + import Distribution.Simple + main = defaultMainWithHooks simpleUserHooks { postHaddock = posthaddock } + + posthaddock args flags desc info = .... + ~~~~~~~~~~~~~~~~ + + See `UserHooks` in [Distribution.Simple][dist-simple] for the + details, but note that this interface is experimental, and likely + to change in future releases. + + * You could delegate all the work to `make`, though this is unlikely + to be very portable. Cabal supports this with the `build-type` + `Make` and a trivial setup library [Distribution.Make][dist-make], + which simply parses the command line arguments and invokes `make`. + Here `Setup.hs` should look like this: + + ~~~~~~~~~~~~~~~~ + import Distribution.Make + main = defaultMain + ~~~~~~~~~~~~~~~~ + + The root directory of the package should contain a `configure` + script, and, after that has run, a `Makefile` with a default target + that builds the package, plus targets `install`, `register`, + `unregister`, `clean`, `dist` and `docs`. Some options to commands + are passed through as follows: + + * The `--with-hc-pkg`, `--prefix`, `--bindir`, `--libdir`, `--datadir`, + `--libexecdir` and `--sysconfdir` options to the `configure` command are + passed on to the `configure` script. In addition the value of the + `--with-compiler` option is passed in a `--with-hc` option and all + options specified with `--configure-option=` are passed on. + + * The `--destdir` option to the `copy` command becomes a setting + of a `destdir` variable on the invocation of `make copy`. The + supplied `Makefile` should provide a `copy` target, which will + probably look like this: + + ~~~~~~~~~~~~~~~~ + copy : + $(MAKE) install prefix=$(destdir)/$(prefix) \ + bindir=$(destdir)/$(bindir) \ + libdir=$(destdir)/$(libdir) \ + datadir=$(destdir)/$(datadir) \ + libexecdir=$(destdir)/$(libexecdir) \ + sysconfdir=$(destdir)/$(sysconfdir) \ + ~~~~~~~~~~~~~~~~ + + * Finally, with the `build-type` `Custom`, you can also write your + own setup script from scratch. It must conform to the interface + described in the section on [building and installing + packages](installing-packages.html), and you may use the Cabal + library for all or part of the work. One option is to copy the + source of `Distribution.Simple`, and alter it for your needs. Good + luck. + + + +[dist-simple]: ../release/cabal-latest/doc/API/Cabal/Distribution-Simple.html +[dist-make]: ../release/cabal-latest/doc/API/Cabal/Distribution-Make.html +[dist-license]: ../release/cabal-latest/doc/API/Cabal/Distribution-License.html#t:License +[extension]: ../release/cabal-latest/doc/API/Cabal/Language-Haskell-Extension.html#t:Extension +[BuildType]: ../release/cabal-latest/doc/API/Cabal/Distribution-PackageDescription.html#t:BuildType +[data-version]: http://hackage.haskell.org/packages/archive/base/latest/doc/html/Data-Version.html +[alex]: http://www.haskell.org/alex/ +[autoconf]: http://www.gnu.org/software/autoconf/ +[c2hs]: http://www.cse.unsw.edu.au/~chak/haskell/c2hs/ +[cpphs]: http://projects.haskell.org/cpphs/ +[greencard]: http://hackage.haskell.org/package/greencard +[haddock]: http://www.haskell.org/haddock/ +[HsColour]: http://www.cs.york.ac.uk/fp/darcs/hscolour/ +[happy]: http://www.haskell.org/happy/ +[Hackage]: http://hackage.haskell.org/ +[pkg-config]: http://www.freedesktop.org/wiki/Software/pkg-config/ +[REPL]: http://en.wikipedia.org/wiki/Read%E2%80%93eval%E2%80%93print_loop diff --git a/doc/index.markdown b/doc/index.markdown new file mode 100644 --- /dev/null +++ b/doc/index.markdown @@ -0,0 +1,200 @@ +% Cabal User Guide + +Cabal is the standard package system for [Haskell] software. It helps +people to configure, build and install Haskell software and to +distribute it easily to other users and developers. + +There is a command line tool called `cabal` for working with Cabal +packages. It helps with installing existing packages and also helps +people developing their own packages. It can be used to work with local +packages or to install packages from online package archives, including +automatically installing dependencies. By default it is configured to +use [Hackage] which is Haskell's central package archive that contains +thousands of libraries and applications in the Cabal package format. + +# Contents # + + * [Introduction](#introduction) + - [What's in a package](#whats-in-a-package) + - [A tool for working with packages](#a-tool-for-working-with-packages) + * [Building, installing and managing packages](installing-packages.html) + * [Creating packages](developing-packages.html) + * [Reporting bugs and deficiencies](misc.html#reporting-bugs-and-deficiencies) + * [Stability of Cabal interfaces](misc.html#stability-of-cabal-interfaces) + +# Introduction # + +Cabal is a package system for Haskell software. The point of a package +system is to enable software developers and users to easily distribute, +use and reuse software. A package system makes it easier for developers +to get their software into the hands of users. Equally importantly, it +makes it easier for software developers to be able to reuse software +components written by other developers. + +Packaging systems deal with packages and with Cabal we call them _Cabal +packages_. The Cabal package is the unit of distribution. Every Cabal +package has a name and a version number which are used to identify the +package, e.g. `filepath-1.0`. + +Cabal packages can depend on other Cabal packages. There are tools +to enable automated package management. This means it is possible for +developers and users to install a package plus all of the other Cabal +packages that it depends on. It also means that it is practical to make +very modular systems using lots of packages that reuse code written by +many developers. + +Cabal packages are source based and are typically (but not necessarily) +portable to many platforms and Haskell implementations. The Cabal +package format is designed to make it possible to translate into other +formats, including binary packages for various systems. + +When distributed, Cabal packages use the standard compressed tarball +format, with the file extension `.tar.gz`, e.g. `filepath-1.0.tar.gz`. + +Note that packages are not part of the Haskell language, rather they +are a feature provided by the combination of Cabal and GHC (and several +other Haskell implementations). + + +## A tool for working with packages ## + +There is a command line tool, called "`cabal`", that users and developers +can use to build and install Cabal packages. It can be used for both +local packages and for packages available remotely over the network. It +can automatically install Cabal packages plus any other Cabal packages +they depend on. + +Developers can use the tool with packages in local directories, e.g. + +~~~~~~~~~~~~~~~~ +cd foo/ +cabal install +~~~~~~~~~~~~~~~~ + +While working on a package in a local directory, developers can run the +individual steps to configure and build, and also generate documentation +and run test suites and benchmarks. + +It is also possible to install several local packages at once, e.g. + +~~~~~~~~~~~~~~~~ +cabal install foo/ bar/ +~~~~~~~~~~~~~~~~ + +Developers and users can use the tool to install packages from remote +Cabal package archives. By default, the `cabal` tool is configured to +use the central Haskell package archive called [Hackage] but it +is possible to use it with any other suitable archive. + +~~~~~~~~~~~~~~~~ +cabal install xmonad +~~~~~~~~~~~~~~~~ + +This will install the `xmonad` package plus all of its dependencies. + +In addition to packages that have been published in an archive, +developers can install packages from local or remote tarball files, +for example + +~~~~~~~~~~~~~~~~ +cabal install foo-1.0.tar.gz +cabal install http://example.com/foo-1.0.tar.gz +~~~~~~~~~~~~~~~~ + +Cabal provides a number of ways for a user to customise how and where a +package is installed. They can decide where a package will be installed, +which Haskell implementation to use and whether to build optimised code +or build with the ability to profile code. It is not expected that users +will have to modify any of the information in the `.cabal` file. + +For full details, see the section on [building and installing +packages](installing-packages.html). + +Note that `cabal` is not the only tool for working with Cabal packages. +Due to the standardised format and a library for reading `.cabal` files, +there are several other special-purpose tools. + +## What's in a package ## + +A Cabal package consists of: + + * Haskell software, including libraries, executables and tests + * metadata about the package in a standard human and machine + readable format (the "`.cabal`" file) + * a standard interface to build the package (the "`Setup.hs`" file) + +The `.cabal` file contains information about the package, supplied by +the package author. In particular it lists the other Cabal packages +that the package depends on. + +For full details on what goes in the `.cabal` and `Setup.hs` files, and +for all the other features provided by the build system, see the section +on [developing packages](developing-packages.html). + + +## Cabal featureset ## + +Cabal and its associated tools and websites covers: + + * a software build system + * software configuration + * packaging for distribution + * automated package management + * natively using the `cabal` command line tool; or + * by translation into native package formats such as RPM or deb + * web and local Cabal package archives + * central Hackage website with 1000's of Cabal packages + +Some parts of the system can be used without others. In particular the +built-in build system for simple packages is optional: it is possible +to use custom build systems. + +## Similar systems ## + +The Cabal system is roughly comparable with the system of Python Eggs, +Ruby Gems or Perl distributions. Each system has a notion of +distributable packages, and has tools to manage the process of +distributing and installing packages. + +Hackage is an online archive of Cabal packages. It is roughly comparable +to CPAN but with rather fewer packages (around 5,000 vs 28,000). + +Cabal is often compared with autoconf and automake and there is some +overlap in functionality. The most obvious similarity is that the +command line interface for actually configuring and building packages +follows the same steps and has many of the same configuration +parameters. + +~~~~~~~~~~ +./configure --prefix=... +make +make install +~~~~~~~~~~ + +compared to + +~~~~~~~~~~ +cabal configure --prefix=... +cabal build +cabal install +~~~~~~~~~~ + +Cabal's build system for simple packages is considerably less flexible +than make/automake, but has builtin knowledge of how to build Haskell +code and requires very little manual configuration. Cabal's simple build +system is also portable to Windows, without needing a Unix-like +environment such as cygwin/mingwin. + +Compared to autoconf, Cabal takes a somewhat different approach to +package configuration. Cabal's approach is designed for automated +package management. Instead of having a configure script that tests for +whether dependencies are available, Cabal packages specify their +dependencies. There is some scope for optional and conditional +dependencies. By having package authors specify dependencies it makes it +possible for tools to install a package and all of its dependencies +automatically. It also makes it possible to translate (in a +mostly-automatically way) into another package format like RPM or deb +which also have automatic dependency resolution. + +[Haskell]: http://www.haskell.org/ +[Hackage]: http://hackage.haskell.org/ diff --git a/doc/installing-packages.markdown b/doc/installing-packages.markdown new file mode 100644 --- /dev/null +++ b/doc/installing-packages.markdown @@ -0,0 +1,1067 @@ +% Cabal User Guide + +# Building and installing packages # + +After you've unpacked a Cabal package, you can build it by moving into +the root directory of the package and running the `cabal` tool there: + +> `cabal [command] [option...]` + +The _command_ argument selects a particular step in the build/install process. + +You can also get a summary of the command syntax with + +> `cabal help` + +Alternatively, you can also use the `Setup.hs` or `Setup.lhs` script: + +> `runhaskell Setup.hs [command] [option...]` + +For the summary of the command syntax, run: + +> `cabal help` + +or + +> `runhaskell Setup.hs --help` + +## Building and installing a system package ## + +~~~~~~~~~~~~~~~~ +runhaskell Setup.hs configure --ghc +runhaskell Setup.hs build +runhaskell Setup.hs install +~~~~~~~~~~~~~~~~ + +The first line readies the system to build the tool using GHC; for +example, it checks that GHC exists on the system. The second line +performs the actual building, while the last both copies the build +results to some permanent place and registers the package with GHC. + +## Building and installing a user package ## + +~~~~~~~~~~~~~~~~ +runhaskell Setup.hs configure --user +runhaskell Setup.hs build +runhaskell Setup.hs install +~~~~~~~~~~~~~~~~ + +The package is installed under the user's home directory and is +registered in the user's package database (`--user`). + +## Installing packages from Hackage ## + +The `cabal` tool also can download, configure, build and install a [Hackage] +package and all of its dependencies in a single step. To do this, run: + +~~~~~~~~~~~~~~~~ +cabal install [PACKAGE...] +~~~~~~~~~~~~~~~~ + +To browse the list of available packages, visit the [Hackage] web site. + +## Developing with sandboxes ## + +By default, any dependencies of the package are installed into the global or +user package databases (e.g. using `cabal install --only-dependencies`). If +you're building several different packages that have incompatible dependencies, +this can cause the build to fail. One way to avoid this problem is to build each +package in an isolated environment ("sandbox"), with a sandbox-local package +database. Because sandboxes are per-project, inconsistent dependencies can be +simply disallowed. + +For more on sandboxes, see also +[this article](http://coldwa.st/e/blog/2013-08-20-Cabal-sandbox.html). + +### Sandboxes: basic usage ### + +To initialise a fresh sandbox in the current directory, run `cabal sandbox +init`. All subsequent commands (such as `build` and `install`) from this point +will use the sandbox. + +~~~~~~~~~~~~~~~ +$ cd /path/to/my/haskell/library +$ cabal sandbox init # Initialise the sandbox +$ cabal install --only-dependencies # Install dependencies into the sandbox +$ cabal build # Build your package inside the sandbox +~~~~~~~~~~~~~~~ + +It can be useful to make a source package available for installation in the +sandbox - for example, if your package depends on a patched or an unreleased +version of a library. This can be done with the `cabal sandbox add-source` +command - think of it as "local [Hackage]". If an add-source dependency is later +modified, it is reinstalled automatically. + +~~~~~~~~~~~~~~~ +$ cabal sandbox add-source /my/patched/library # Add a new add-source dependency +$ cabal install --dependencies-only # Install it into the sandbox +$ cabal build # Build the local package +$ $EDITOR /my/patched/library/Source.hs # Modify the add-source dependency +$ cabal build # Modified dependency is automatically reinstalled +~~~~~~~~~~~~~~~ + +Normally, the sandbox settings (such as optimisation level) are inherited from +the main Cabal config file (`$HOME/cabal/config`). Sometimes, though, you need +to change some settings specifically for a single sandbox. You can do this by +creating a `cabal.config` file in the same directory with your +`cabal.sandbox.config` (which was created by `sandbox init`). This file has the +same syntax as the main Cabal config file. + +~~~~~~~~~~~~~~~ +$ cat cabal.config +documentation: True +constraints: foo == 1.0, bar >= 2.0, baz +$ cabal build # Uses settings from the cabal.config file +~~~~~~~~~~~~~~~ + +When you have decided that you no longer want to build your package inside a +sandbox, just delete it: + +~~~~~~~~~~~~~~~ +$ cabal sandbox delete # Built-in command +$ rm -rf .cabal-sandbox cabal.sandbox.config # Alternative manual method +~~~~~~~~~~~~~~~ + +### Sandboxes: advanced usage ### + +The default behaviour of the `add-source` command is to track modifications done +to the added dependency and reinstall the sandbox copy of the package when +needed. Sometimes this is not desirable: in these cases you can use `add-source +--snapshot`, which disables the change tracking. In addition to `add-source`, +there are also `list-sources` and `delete-source` commands. + +Sometimes one wants to share a single sandbox between multiple packages. This +can be easily done with the `--sandbox` option: + +~~~~~~~~~~~~~~~ +$ mkdir -p /path/to/shared-sandbox +$ cd /path/to/shared-sandbox +$ cabal sandbox init --sandbox . +$ cd /path/to/package-a +$ cabal sandbox init --sandbox /path/to/shared-sandbox +$ cd /path/to/package-b +$ cabal sandbox init --sandbox /path/to/shared-sandbox +~~~~~~~~~~~~~~~ + +Note that `cabal sandbox init --sandbox .` puts all sandbox files into the +current directory. By default, `cabal sandbox init` initialises a new sandbox in +a newly-created subdirectory of the current working directory +(`./.cabal-sandbox`). + +Using multiple different compiler versions simultaneously is also supported, via +the `-w` option: + +~~~~~~~~~~~~~~~ +$ cabal sandbox init +$ cabal install --only-dependencies -w /path/to/ghc-1 # Install dependencies for both compilers +$ cabal install --only-dependencies -w /path/to/ghc-2 +$ cabal configure -w /path/to/ghc-1 # Build with the first compiler +$ cabal build +$ cabal configure -w /path/to/ghc-2 # Build with the second compiler +$ cabal build +~~~~~~~~~~~~~~~ + +It can be occasionally useful to run the compiler-specific package manager tool +(e.g. `ghc-pkg`) tool on the sandbox package DB directly (for example, you may +need to unregister some packages). The `cabal sandbox hc-pkg` command is a +convenient wrapper that runs the compiler-specific package manager tool with the +arguments: + +~~~~~~~~~~~~~~~ +$ cabal -v sandbox hc-pkg list +Using a sandbox located at /path/to/.cabal-sandbox +'ghc-pkg' '--global' '--no-user-package-conf' + '--package-conf=/path/to/.cabal-sandbox/i386-linux-ghc-7.4.2-packages.conf.d' + 'list' +[...] +~~~~~~~~~~~~~~~ + +The `--require-sandbox` option makes all sandbox-aware commands +(`install`/`build`/etc.) exit with error if there is no sandbox present. This +makes it harder to accidentally modify the user package database. The option can +be also turned on via the per-user configuration file (`~/.cabal/config`) or the +per-project one (`$PROJECT_DIR/cabal.config`). The error can be squelched with +`--no-require-sandbox`. + +The option `--sandbox-config-file` allows to specify the location of the +`cabal.sandbox.config` file (by default, `cabal` searches for it in the current +directory). This provides the same functionality as shared sandboxes, but +sometimes can be more convenient. Example: + +~~~~~~~~~~~~~~~ +$ mkdir my/sandbox +$ cd my/sandbox +$ cabal sandbox init +$ cd /path/to/my/project +$ cabal --sandbox-config-file=/path/to/my/sandbox/cabal.sandbox.config install +# Uses the sandbox located at /path/to/my/sandbox/.cabal-sandbox +$ cd ~ +$ cabal --sandbox-config-file=/path/to/my/sandbox/cabal.sandbox.config install +# Still uses the same sandbox +~~~~~~~~~~~~~~~ + +The sandbox config file can be also specified via the `CABAL_SANDBOX_CONFIG` +environment variable. + +Finally, the flag `--ignore-sandbox` lets you temporarily ignore an existing +sandbox: + +~~~~~~~~~~~~~~~ +$ mkdir my/sandbox +$ cd my/sandbox +$ cabal sandbox init +$ cabal --ignore-sandbox install text +# Installs 'text' in the user package database ('~/.cabal'). +~~~~~~~~~~~~~~~ + +## Creating a binary package ## + +When creating binary packages (e.g. for Red Hat or Debian) one needs to +create a tarball that can be sent to another system for unpacking in the +root directory: + +~~~~~~~~~~~~~~~~ +runhaskell Setup.hs configure --prefix=/usr +runhaskell Setup.hs build +runhaskell Setup.hs copy --destdir=/tmp/mypkg +tar -czf mypkg.tar.gz /tmp/mypkg/ +~~~~~~~~~~~~~~~~ + +If the package contains a library, you need two additional steps: + +~~~~~~~~~~~~~~~~ +runhaskell Setup.hs register --gen-script +runhaskell Setup.hs unregister --gen-script +~~~~~~~~~~~~~~~~ + +This creates shell scripts `register.sh` and `unregister.sh`, which must +also be sent to the target system. After unpacking there, the package +must be registered by running the `register.sh` script. The +`unregister.sh` script would be used in the uninstall procedure of the +package. Similar steps may be used for creating binary packages for +Windows. + + +The following options are understood by all commands: + +`--help`, `-h` or `-?` +: List the available options for the command. + +`--verbose=`_n_ or `-v`_n_ +: Set the verbosity level (0-3). The normal level is 1; a missing _n_ + defaults to 2. + +The various commands and the additional options they support are +described below. In the simple build infrastructure, any other options +will be reported as errors. + +## setup configure ## + +Prepare to build the package. Typically, this step checks that the +target platform is capable of building the package, and discovers +platform-specific features that are needed during the build. + +The user may also adjust the behaviour of later stages using the options +listed in the following subsections. In the simple build +infrastructure, the values supplied via these options are recorded in a +private file read by later stages. + +If a user-supplied `configure` script is run (see the section on +[system-dependent +parameters](developing-packages.html#system-dependent-parameters) or on +[complex packages](developing-packages.html#more-complex-packages)), it +is passed the `--with-hc-pkg`, `--prefix`, `--bindir`, `--libdir`, +`--datadir`, `--libexecdir` and `--sysconfdir` options. In addition the +value of the `--with-compiler` option is passed in a `--with-hc` option +and all options specified with `--configure-option=` are passed on. + +### Programs used for building ### + +The following options govern the programs used to process the source +files of a package: + +`--ghc` or `-g`, `--jhc`, `--lhc`, `--uhc` +: Specify which Haskell implementation to use to build the package. + At most one of these flags may be given. If none is given, the + implementation under which the setup script was compiled or + interpreted is used. + +`--with-compiler=`_path_ or `-w`_path_ +: Specify the path to a particular compiler. If given, this must match + the implementation selected above. The default is to search for the + usual name of the selected implementation. + + This flag also sets the default value of the `--with-hc-pkg` option + to the package tool for this compiler. Check the output of `setup + configure -v` to ensure that it finds the right package tool (or use + `--with-hc-pkg` explicitly). + + +`--with-hc-pkg=`_path_ +: Specify the path to the package tool, e.g. `ghc-pkg`. The package + tool must be compatible with the compiler specified by + `--with-compiler`. If this option is omitted, the default value is + determined from the compiler selected. + +`--with-`_`prog`_`=`_path_ +: Specify the path to the program _prog_. Any program known to Cabal + can be used in place of _prog_. It can either be a fully path or the + name of a program that can be found on the program search path. For + example: `--with-ghc=ghc-6.6.1` or + `--with-cpphs=/usr/local/bin/cpphs`. + The full list of accepted programs is not enumerated in this user guide. + Rather, run `cabal install --help` to view the list. + +`--`_`prog`_`-options=`_options_ +: Specify additional options to the program _prog_. Any program known + to Cabal can be used in place of _prog_. For example: + `--alex-options="--template=mytemplatedir/"`. The _options_ is split + into program options based on spaces. Any options containing embedded + spaced need to be quoted, for example + `--foo-options='--bar="C:\Program File\Bar"'`. As an alternative + that takes only one option at a time but avoids the need to quote, + use `--`_`prog`_`-option` instead. + +`--`_`prog`_`-option=`_option_ +: Specify a single additional option to the program _prog_. For + passing an option that contain embedded spaces, such as a file name + with embedded spaces, using this rather than `--`_`prog`_`-options` + means you do not need an additional level of quoting. Of course if + you are using a command shell you may still need to quote, for + example `--foo-options="--bar=C:\Program File\Bar"`. + +All of the options passed with either `--`_`prog`_`-options` or +`--`_`prog`_`-option` are passed in the order they were specified on the +configure command line. + +### Installation paths ### + +The following options govern the location of installed files from a +package: + +`--prefix=`_dir_ +: The root of the installation. For example for a global install you + might use `/usr/local` on a Unix system, or `C:\Program Files` on a + Windows system. The other installation paths are usually + subdirectories of _prefix_, but they don't have to be. + + In the simple build system, _dir_ may contain the following path + variables: `$pkgid`, `$pkg`, `$version`, `$compiler`, `$os`, + `$arch`, `$abi`, `$abitag` + +`--bindir=`_dir_ +: Executables that the user might invoke are installed here. + + In the simple build system, _dir_ may contain the following path + variables: `$prefix`, `$pkgid`, `$pkg`, `$version`, `$compiler`, + `$os`, `$arch`, `$abi`, `$abitag + +`--libdir=`_dir_ +: Object-code libraries are installed here. + + In the simple build system, _dir_ may contain the following path + variables: `$prefix`, `$bindir`, `$pkgid`, `$pkg`, `$version`, + `$compiler`, `$os`, `$arch`, `$abi`, `$abitag` + +`--libexecdir=`_dir_ +: Executables that are not expected to be invoked directly by the user + are installed here. + + In the simple build system, _dir_ may contain the following path + variables: `$prefix`, `$bindir`, `$libdir`, `$libsubdir`, `$pkgid`, + `$pkg`, `$version`, `$compiler`, `$os`, `$arch`, `$abi`, `$abitag` + +`--datadir`=_dir_ +: Architecture-independent data files are installed here. + + In the simple build system, _dir_ may contain the following path + variables: `$prefix`, `$bindir`, `$libdir`, `$libsubdir`, `$pkgid`, `$pkg`, + `$version`, `$compiler`, `$os`, `$arch`, `$abi`, `$abitag` + +`--sysconfdir=`_dir_ +: Installation directory for the configuration files. + + In the simple build system, _dir_ may contain the following path variables: + `$prefix`, `$bindir`, `$libdir`, `$libsubdir`, `$pkgid`, `$pkg`, `$version`, + `$compiler`, `$os`, `$arch`, `$abi`, `$abitag` + +In addition the simple build system supports the following installation path options: + +`--libsubdir=`_dir_ +: A subdirectory of _libdir_ in which libraries are actually + installed. For example, in the simple build system on Unix, the + default _libdir_ is `/usr/local/lib`, and _libsubdir_ contains the + package identifier and compiler, e.g. `mypkg-0.2/ghc-6.4`, so + libraries would be installed in `/usr/local/lib/mypkg-0.2/ghc-6.4`. + + _dir_ may contain the following path variables: `$pkgid`, `$pkg`, + `$version`, `$compiler`, `$os`, `$arch`, `$abi`, `$abitag` + +`--datasubdir=`_dir_ +: A subdirectory of _datadir_ in which data files are actually + installed. + + _dir_ may contain the following path variables: `$pkgid`, `$pkg`, + `$version`, `$compiler`, `$os`, `$arch`, `$abi`, `$abitag` + +`--docdir=`_dir_ +: Documentation files are installed relative to this directory. + + _dir_ may contain the following path variables: `$prefix`, `$bindir`, + `$libdir`, `$libsubdir`, `$datadir`, `$datasubdir`, `$pkgid`, `$pkg`, + `$version`, `$compiler`, `$os`, `$arch`, `$abi`, `$abitag` + +`--htmldir=`_dir_ +: HTML documentation files are installed relative to this directory. + + _dir_ may contain the following path variables: `$prefix`, `$bindir`, + `$libdir`, `$libsubdir`, `$datadir`, `$datasubdir`, `$docdir`, `$pkgid`, + `$pkg`, `$version`, `$compiler`, `$os`, `$arch`, `$abi`, `$abitag` + +`--program-prefix=`_prefix_ +: Prepend _prefix_ to installed program names. + + _prefix_ may contain the following path variables: `$pkgid`, `$pkg`, + `$version`, `$compiler`, `$os`, `$arch`, `$abi`, `$abitag` + +`--program-suffix=`_suffix_ +: Append _suffix_ to installed program names. The most obvious use for + this is to append the program's version number to make it possible + to install several versions of a program at once: + `--program-suffix='$version'`. + + _suffix_ may contain the following path variables: `$pkgid`, `$pkg`, + `$version`, `$compiler`, `$os`, `$arch`, `$abi`, `$abitag` + +#### Path variables in the simple build system #### + +For the simple build system, there are a number of variables that can be +used when specifying installation paths. The defaults are also specified +in terms of these variables. A number of the variables are actually for +other paths, like `$prefix`. This allows paths to be specified relative +to each other rather than as absolute paths, which is important for +building relocatable packages (see [prefix +independence](#prefix-independence)). + +`$prefix` +: The path variable that stands for the root of the installation. For + an installation to be relocatable, all other installation paths must + be relative to the `$prefix` variable. + +`$bindir` +: The path variable that expands to the path given by the `--bindir` + configure option (or the default). + +`$libdir` +: As above but for `--libdir` + +`$libsubdir` +: As above but for `--libsubdir` + +`$datadir` +: As above but for `--datadir` + +`$datasubdir` +: As above but for `--datasubdir` + +`$docdir` +: As above but for `--docdir` + +`$pkgid` +: The name and version of the package, e.g. `mypkg-0.2` + +`$pkg` +: The name of the package, e.g. `mypkg` + +`$version` +: The version of the package, e.g. `0.2` + +`$compiler` +: The compiler being used to build the package, e.g. `ghc-6.6.1` + +`$os` +: The operating system of the computer being used to build the + package, e.g. `linux`, `windows`, `osx`, `freebsd` or `solaris` + +`$arch` +: The architecture of the computer being used to build the package, e.g. + `i386`, `x86_64`, `ppc` or `sparc` + +`$abitag` +: An optional tag that a compiler can use for telling incompatible ABI's + on the same architecture apart. GHCJS encodes the underlying GHC version + in the ABI tag. + +`$abi` +: A shortcut for getting a path that completely identifies the platform in terms + of binary compatibility. Expands to the same value as `$arch-$os-compiler-$abitag` + if the compiler uses an abi tag, `$arch-$os-$compiler` if it doesn't. + +#### Paths in the simple build system #### + +For the simple build system, the following defaults apply: + +Option Windows Default Unix Default +------- ---------------- ------------- +`--prefix` (global) `C:\Program Files\Haskell` `/usr/local` +`--prefix` (per-user) `C:\Documents And Settings\user\Application Data\cabal` `$HOME/.cabal` +`--bindir` `$prefix\bin` `$prefix/bin` +`--libdir` `$prefix` `$prefix/lib` +`--libsubdir` (others) `$pkgid\$compiler` `$pkgid/$compiler` +`--libexecdir` `$prefix\$pkgid` `$prefix/libexec` +`--datadir` (executable) `$prefix` `$prefix/share` +`--datadir` (library) `C:\Program Files\Haskell` `$prefix/share` +`--datasubdir` `$pkgid` `$pkgid` +`--docdir` `$prefix\doc\$pkgid` `$datadir/doc/$pkgid` +`--sysconfdir` `$prefix\etc` `$prefix/etc` +`--htmldir` `$docdir\html` `$docdir/html` +`--program-prefix` (empty) (empty) +`--program-suffix` (empty) (empty) + + +#### Prefix-independence #### + +On Windows it is possible to obtain the pathname of the running program. This +means that we can construct an installable executable package that is +independent of its absolute install location. The executable can find its +auxiliary files by finding its own path and knowing the location of the other +files relative to `$bindir`. Prefix-independence is particularly useful: it +means the user can choose the install location (i.e. the value of `$prefix`) at +install-time, rather than having to bake the path into the binary when it is +built. + +In order to achieve this, we require that for an executable on Windows, +all of `$bindir`, `$libdir`, `$datadir` and `$libexecdir` begin with +`$prefix`. If this is not the case then the compiled executable will +have baked-in all absolute paths. + +The application need do nothing special to achieve prefix-independence. +If it finds any files using `getDataFileName` and the [other functions +provided for the +purpose](developing-packages.html#accessing-data-files-from-package-code), +the files will be accessed relative to the location of the current +executable. + +A library cannot (currently) be prefix-independent, because it will be +linked into an executable whose file system location bears no relation +to the library package. + +### Controlling Flag Assignments ### + +Flag assignments (see the [resolution of conditions and +flags](developing-packages.html#resolution-of-conditions-and-flags)) can +be controlled with the following command line options. + +`-f` _flagname_ or `-f` `-`_flagname_ +: Force the specified flag to `true` or `false` (if preceded with a `-`). Later + specifications for the same flags will override earlier, i.e., + specifying `-fdebug -f-debug` is equivalent to `-f-debug` + +`--flags=`_flagspecs_ +: Same as `-f`, but allows specifying multiple flag assignments at + once. The parameter is a space-separated list of flag names (to + force a flag to `true`), optionally preceded by a `-` (to force a + flag to `false`). For example, `--flags="debug -feature1 feature2"` is + equivalent to `-fdebug -f-feature1 -ffeature2`. + +### Building Test Suites ### + +`--enable-tests` +: Build the test suites defined in the package description file during the + `build` stage. Check for dependencies required by the test suites. If the + package is configured with this option, it will be possible to run the test + suites with the `test` command after the package is built. + +`--disable-tests` +: (default) Do not build any test suites during the `build` stage. + Do not check for dependencies required only by the test suites. It will not + be possible to invoke the `test` command without reconfiguring the package. + +`--enable-coverage` +: Build libraries and executables (including test suites) with Haskell + Program Coverage enabled. Running the test suites will automatically + generate coverage reports with HPC. + +`--disable-coverage` +: (default) Do not enable Haskell Program Coverage. + +### Miscellaneous options ## + +`--user` +: Does a per-user installation. This changes the [default installation + prefix](#paths-in-the-simple-build-system). It also allow + dependencies to be satisfied by the user's package database, in + addition to the global database. This also implies a default of + `--user` for any subsequent `install` command, as packages + registered in the global database should not depend on packages + registered in a user's database. + +`--global` +: (default) Does a global installation. In this case package + dependencies must be satisfied by the global package database. All + packages in the user's package database will be ignored. Typically + the final installation step will require administrative privileges. + +`--package-db=`_db_ +: Allows package dependencies to be satisfied from this additional + package database _db_ in addition to the global package database. + All packages in the user's package database will be ignored. The + interpretation of _db_ is implementation-specific. Typically it will + be a file or directory. Not all implementations support arbitrary + package databases. + +`--enable-optimization`[=_n_] or `-O`[_n_] +: (default) Build with optimization flags (if available). This is + appropriate for production use, taking more time to build faster + libraries and programs. + + The optional _n_ value is the optimisation level. Some compilers + support multiple optimisation levels. The range is 0 to 2. Level 0 + is equivalent to `--disable-optimization`, level 1 is the default if + no _n_ parameter is given. Level 2 is higher optimisation if the + compiler supports it. Level 2 is likely to lead to longer compile + times and bigger generated code. + +`--disable-optimization` +: Build without optimization. This is suited for development: building + will be quicker, but the resulting library or programs will be slower. + +`--enable-library-profiling` or `-p` +: Request that an additional version of the library with profiling + features enabled be built and installed (only for implementations + that support profiling). + +`--disable-library-profiling` +: (default) Do not generate an additional profiling version of the + library. + +`--enable-profiling` +: Any executables generated should have profiling enabled (only for + implementations that support profiling). For this to work, all + libraries used by these executables must also have been built with + profiling support. The library will be built with profiling enabled (if + supported) unless `--disable-library-profiling` is specified. + +`--disable-profiling` +: (default) Do not enable profiling in generated executables. + +`--enable-library-vanilla` +: (default) Build ordinary libraries (as opposed to profiling + libraries). This is independent of the `--enable-library-profiling` + option. If you enable both, you get both. + +`--disable-library-vanilla` +: Do not build ordinary libraries. This is useful in conjunction with + `--enable-library-profiling` to build only profiling libraries, + rather than profiling and ordinary libraries. + +`--enable-library-for-ghci` +: (default) Build libraries suitable for use with GHCi. + +`--disable-library-for-ghci` +: Not all platforms support GHCi and indeed on some platforms, trying + to build GHCi libs fails. In such cases this flag can be used as a + workaround. + +`--enable-split-objs` +: Use the GHC `-split-objs` feature when building the library. This + reduces the final size of the executables that use the library by + allowing them to link with only the bits that they use rather than + the entire library. The downside is that building the library takes + longer and uses considerably more memory. + +`--disable-split-objs` +: (default) Do not use the GHC `-split-objs` feature. This makes + building the library quicker but the final executables that use the + library will be larger. + +`--enable-executable-stripping` +: (default) When installing binary executable programs, run the + `strip` program on the binary. This can considerably reduce the size + of the executable binary file. It does this by removing debugging + information and symbols. While such extra information is useful for + debugging C programs with traditional debuggers it is rarely helpful + for debugging binaries produced by Haskell compilers. + + Not all Haskell implementations generate native binaries. For such + implementations this option has no effect. + +`--disable-executable-stripping` +: Do not strip binary executables during installation. You might want + to use this option if you need to debug a program using gdb, for + example if you want to debug the C parts of a program containing + both Haskell and C code. Another reason is if your are building a + package for a system which has a policy of managing the stripping + itself (such as some Linux distributions). + +`--enable-shared` +: Build shared library. This implies a separate compiler run to + generate position independent code as required on most platforms. + +`--disable-shared` +: (default) Do not build shared library. + +`--enable-executable-dynamic` +: Link executables dynamically. The executable's library dependencies should + be built as shared objects. This implies `--enable-shared` unless + `--disable-shared` is explicitly specified. + +`--disable-executable-dynamic` +: (default) Link executables statically. + +`--configure-option=`_str_ +: An extra option to an external `configure` script, if one is used + (see the section on [system-dependent + parameters](developing-packages.html#system-dependent-parameters)). + There can be several of these options. + +`--extra-include-dirs`[=_dir_] +: An extra directory to search for C header files. You can use this + flag multiple times to get a list of directories. + + You might need to use this flag if you have standard system header + files in a non-standard location that is not mentioned in the + package's `.cabal` file. Using this option has the same affect as + appending the directory _dir_ to the `include-dirs` field in each + library and executable in the package's `.cabal` file. The advantage + of course is that you do not have to modify the package at all. + These extra directories will be used while building the package and + for libraries it is also saved in the package registration + information and used when compiling modules that use the library. + +`--extra-lib-dirs`[=_dir_] +: An extra directory to search for system libraries files. You can use + this flag multiple times to get a list of directories. + + You might need to use this flag if you have standard system + libraries in a non-standard location that is not mentioned in the + package's `.cabal` file. Using this option has the same affect as + appending the directory _dir_ to the `extra-lib-dirs` field in each + library and executable in the package's `.cabal` file. The advantage + of course is that you do not have to modify the package at all. + These extra directories will be used while building the package and + for libraries it is also saved in the package registration + information and used when compiling modules that use the library. + +`--allow-newer`[=_pkgs_] +: Selectively relax upper bounds in dependencies without editing the + package description. + + If you want to install a package A that depends on B >= 1.0 && < 2.0, but + you have the version 2.0 of B installed, you can compile A against B 2.0 by + using `cabal install --allow-newer=B A`. This works for the whole package + index: if A also depends on C that in turn depends on B < 2.0, C's + dependency on B will be also relaxed. + + Example: + + ~~~~~~~~~~~~~~~~ + $ cd foo + $ cabal configure + Resolving dependencies... + cabal: Could not resolve dependencies: + [...] + $ cabal configure --allow-newer + Resolving dependencies... + Configuring foo... + ~~~~~~~~~~~~~~~~ + + Additional examples: + + ~~~~~~~~~~~~~~~~ + # Relax upper bounds in all dependencies. + $ cabal install --allow-newer foo + + # Relax upper bounds only in dependencies on bar, baz and quux. + $ cabal install --allow-newer=bar,baz,quux foo + + # Relax the upper bound on bar and force bar==2.1. + $ cabal install --allow-newer=bar --constraint="bar==2.1" foo + ~~~~~~~~~~~~~~~~ + + It's also possible to enable `--allow-newer` permanently by setting + `allow-newer: True` in the `~/.cabal/config` file. + +`--constraint=`_constraint_ +: Restrict solutions involving a package to a given version range. + For example, `cabal install --constraint="bar==2.1"` will only consider + install plans that do not use `bar` at all, or `bar` of version 2.1. + + As a special case, `cabal install --constraint="bar -none"` prevents `bar` + from being used at all (`-none` abbreviates `> 1 && < 1`); `cabal install + --constraint="bar installed"` prevents reinstallation of the `bar` package; + `cabal install --constraint="bar +foo -baz"` specifies that the flag `foo` + should be turned on and the `baz` flag should be turned off. + +## setup build ## + +Perform any preprocessing or compilation needed to make this package ready for installation. + +This command takes the following options: + +--_prog_-options=_options_, --_prog_-option=_option_ +: These are mostly the same as the [options configure + step](#setup-configure). Unlike the options specified at the + configure step, any program options specified at the build step are + not persistent but are used for that invocation only. They options + specified at the build step are in addition not in replacement of + any options specified at the configure step. + +## setup haddock ## + +Build the documentation for the package using [haddock][]. By default, +only the documentation for the exposed modules is generated (but see the +`--executables` and `--internal` flags below). + +This command takes the following options: + +`--hoogle` +: Generate a file `dist/doc/html/`_pkgid_`.txt`, which can be + converted by [Hoogle](http://www.haskell.org/hoogle/) into a + database for searching. This is equivalent to running [haddock][] + with the `--hoogle` flag. + +`--html-location=`_url_ +: Specify a template for the location of HTML documentation for + prerequisite packages. The substitutions ([see + listing](#paths-in-the-simple-build-system)) are applied to the + template to obtain a location for each package, which will be used + by hyperlinks in the generated documentation. For example, the + following command generates links pointing at [Hackage] pages: + + > setup haddock --html-location='http://hackage.haskell.org/packages/archive/$pkg/latest/doc/html' + + Here the argument is quoted to prevent substitution by the shell. If + this option is omitted, the location for each package is obtained + using the package tool (e.g. `ghc-pkg`). + +`--executables` +: Also run [haddock][] for the modules of all the executable programs. + By default [haddock][] is run only on the exported modules. + +`--internal` +: Run [haddock][] for the all modules, including unexposed ones, and + make [haddock][] generate documentation for unexported symbols as + well. + +`--css=`_path_ +: The argument _path_ denotes a CSS file, which is passed to + [haddock][] and used to set the style of the generated + documentation. This is only needed to override the default style + that [haddock][] uses. + +`--hyperlink-source` +: Generate [haddock][] documentation integrated with [HsColour][]. + First, [HsColour][] is run to generate colourised code. Then + [haddock][] is run to generate HTML documentation. Each entity + shown in the documentation is linked to its definition in the + colourised code. + +`--hscolour-css=`_path_ +: The argument _path_ denotes a CSS file, which is passed to [HsColour][] as in + + > runhaskell Setup.hs hscolour --css=_path_ + +## setup hscolour ## + +Produce colourised code in HTML format using [HsColour][]. Colourised +code for exported modules is put in `dist/doc/html/`_pkgid_`/src`. + +This command takes the following options: + +`--executables` +: Also run [HsColour][] on the sources of all executable programs. + Colourised code is put in `dist/doc/html/`_pkgid_/_executable_`/src`. + +`--css=`_path_ +: Use the given CSS file for the generated HTML files. The CSS file + defines the colours used to colourise code. Note that this copies + the given CSS file to the directory with the generated HTML files + (renamed to `hscolour.css`) rather than linking to it. + +## setup install ## + +Copy the files into the install locations and (for library packages) +register the package with the compiler, i.e. make the modules it +contains available to programs. + +The [install locations](#installation-paths) are determined by options +to `setup configure`. + +This command takes the following options: + +`--global` +: Register this package in the system-wide database. (This is the + default, unless the `--user` option was supplied to the `configure` + command.) + +`--user` +: Register this package in the user's local package database. (This is + the default if the `--user` option was supplied to the `configure` + command.) + +## setup copy ## + +Copy the files without registering them. This command is mainly of use +to those creating binary packages. + +This command takes the following option: + +`--destdir=`_path_ + +Specify the directory under which to place installed files. If this is +not given, then the root directory is assumed. + +## setup register ## + +Register this package with the compiler, i.e. make the modules it +contains available to programs. This only makes sense for library +packages. Note that the `install` command incorporates this action. The +main use of this separate command is in the post-installation step for a +binary package. + +This command takes the following options: + +`--global` +: Register this package in the system-wide database. (This is the default.) + + +`--user` +: Register this package in the user's local package database. + + +`--gen-script` +: Instead of registering the package, generate a script containing + commands to perform the registration. On Unix, this file is called + `register.sh`, on Windows, `register.bat`. This script might be + included in a binary bundle, to be run after the bundle is unpacked + on the target system. + +`--gen-pkg-config`[=_path_] +: Instead of registering the package, generate a package registration + file. This only applies to compilers that support package + registration files which at the moment is only GHC. The file should + be used with the compiler's mechanism for registering packages. This + option is mainly intended for packaging systems. If possible use the + `--gen-script` option instead since it is more portable across + Haskell implementations. The _path_ is + optional and can be used to specify a particular output file to + generate. Otherwise, by default the file is the package name and + version with a `.conf` extension. + +`--inplace` +: Registers the package for use directly from the build tree, without + needing to install it. This can be useful for testing: there's no + need to install the package after modifying it, just recompile and + test. + + This flag does not create a build-tree-local package database. It + still registers the package in one of the user or global databases. + + However, there are some caveats. It only works with GHC + (currently). It only works if your package doesn't depend on having + any supplemental files installed --- plain Haskell libraries should + be fine. + +## setup unregister ## + +Deregister this package with the compiler. + +This command takes the following options: + +`--global` +: Deregister this package in the system-wide database. (This is the default.) + +`--user` +: Deregister this package in the user's local package database. + +`--gen-script` +: Instead of deregistering the package, generate a script containing + commands to perform the deregistration. On Unix, this file is + called `unregister.sh`, on Windows, `unregister.bat`. This script + might be included in a binary bundle, to be run on the target + system. + +## setup clean ## + +Remove any local files created during the `configure`, `build`, +`haddock`, `register` or `unregister` steps, and also any files and +directories listed in the `extra-tmp-files` field. + +This command takes the following options: + +`--save-configure` or `-s` +: Keeps the configuration information so it is not necessary to run + the configure step again before building. + +## setup test ## + +Run the test suites specified in the package description file. Aside from +the following flags, Cabal accepts the name of one or more test suites on the +command line after `test`. When supplied, Cabal will run only the named test +suites, otherwise, Cabal will run all test suites in the package. + +`--builddir=`_dir_ +: The directory where Cabal puts generated build files (default: `dist`). + Test logs will be located in the `test` subdirectory. + +`--human-log=`_path_ +: The template used to name human-readable test logs; the path is relative + to `dist/test`. By default, logs are named according to the template + `$pkgid-$test-suite.log`, so that each test suite will be logged to its own + human-readable log file. Template variables allowed are: `$pkgid`, + `$compiler`, `$os`, `$arch`, `$abi`, `$abitag`, `$test-suite`, and `$result`. + +`--machine-log=`_path_ +: The path to the machine-readable log, relative to `dist/test`. The default + template is `$pkgid.log`. Template variables allowed are: `$pkgid`, + `$compiler`, `$os`, `$arch`, `$abi`, `$abitag` and `$result`. + +`--show-details=`_filter_ +: Determines if the results of individual test cases are shown on the + terminal. May be `always` (always show), `never` (never show), `failures` + (show only failed results), or `streaming` (show all results in real time). + +`--test-options=`_options_ +: Give extra options to the test executables. + +`--test-option=`_option_ +: give an extra option to the test executables. There is no need to quote + options containing spaces because a single option is assumed, so options + will not be split on spaces. + +## setup sdist ## + +Create a system- and compiler-independent source distribution in a file +_package_-_version_`.tar.gz` in the `dist` subdirectory, for +distribution to package builders. When unpacked, the commands listed in +this section will be available. + +The files placed in this distribution are the package description file, +the setup script, the sources of the modules named in the package +description file, and files named in the `license-file`, `main-is`, +`c-sources`, `js-sources`, `data-files`, `extra-source-files` and +`extra-doc-files` fields. + +This command takes the following option: + +`--snapshot` +: Append today's date (in "YYYYMMDD" format) to the version number for + the generated source package. The original package is unaffected. + + +[dist-simple]: ../release/cabal-latest/doc/API/Cabal/Distribution-Simple.html +[dist-make]: ../release/cabal-latest/doc/API/Cabal/Distribution-Make.html +[dist-license]: ../release/cabal-latest/doc/API/Cabal/Distribution-License.html#t:License +[extension]: ../release/cabal-latest/doc/API/Cabal/Language-Haskell-Extension.html#t:Extension +[BuildType]: ../release/cabal-latest/doc/API/Cabal/Distribution-PackageDescription.html#t:BuildType +[alex]: http://www.haskell.org/alex/ +[autoconf]: http://www.gnu.org/software/autoconf/ +[c2hs]: http://www.cse.unsw.edu.au/~chak/haskell/c2hs/ +[cpphs]: http://projects.haskell.org/cpphs/ +[greencard]: http://hackage.haskell.org/package/greencard +[haddock]: http://www.haskell.org/haddock/ +[HsColour]: http://www.cs.york.ac.uk/fp/darcs/hscolour/ +[happy]: http://www.haskell.org/happy/ +[Hackage]: http://hackage.haskell.org/ +[pkg-config]: http://www.freedesktop.org/wiki/Software/pkg-config/ diff --git a/doc/misc.markdown b/doc/misc.markdown new file mode 100644 --- /dev/null +++ b/doc/misc.markdown @@ -0,0 +1,109 @@ +% Cabal User Guide + +# Reporting bugs and deficiencies # + +Please report any flaws or feature requests in the [bug tracker][]. + +For general discussion or queries email the libraries mailing list +. There is also a development mailing list +. + +[bug tracker]: https://github.com/haskell/cabal/issues + +# Stability of Cabal interfaces # + +The Cabal library and related infrastructure is still under active +development. New features are being added and limitations and bugs are +being fixed. This requires internal changes and often user visible +changes as well. We therefore cannot promise complete future-proof +stability, at least not without halting all development work. + +This section documents the aspects of the Cabal interface that we can +promise to keep stable and which bits are subject to change. + +## Cabal file format ## + +This is backwards compatible and mostly forwards compatible. New fields +can be added without breaking older versions of Cabal. Fields can be +deprecated without breaking older packages. + +## Command-line interface ## + +### Very Stable Command-line interfaces ### + +* `./setup configure` + * `--prefix` + * `--user` + * `--ghc`, `--uhc` + * `--verbose` + * `--prefix` + +* `./setup build` +* `./setup install` +* `./setup register` +* `./setup copy` + +### Stable Command-line interfaces ### + +### Unstable command-line ### + +## Functions and Types ## + +The Cabal library follows the [Package Versioning Policy][PVP]. This +means that within a stable major release, for example 1.2.x, there will +be no incompatible API changes. But minor versions increments, for +example 1.2.3, indicate compatible API additions. + +The Package Versioning Policy does not require any API guarantees +between major releases, for example between 1.2.x and 1.4.x. In practise +of course not everything changes between major releases. Some parts of +the API are more prone to change than others. The rest of this section +gives some informal advice on what level of API stability you can expect +between major releases. + +[PVP]: http://www.haskell.org/haskellwiki/Package_versioning_policy + +### Very Stable API ### + +* `defaultMain` + +* `defaultMainWithHooks defaultUserHooks` + + But regular `defaultMainWithHooks` isn't stable since `UserHooks` + changes. + +### Semi-stable API ### + +* `UserHooks` The hooks API will change in the future + +* `Distribution.*` is mostly declarative information about packages and + is somewhat stable. + +### Unstable API ### + +Everything under `Distribution.Simple.*` has no stability guarantee. + +## Hackage ## + +The index format is a partly stable interface. It consists of a tar.gz +file that contains directories with `.cabal` files in. In future it may +contain more kinds of files so do not assume every file is a `.cabal` +file. Incompatible revisions to the format would involve bumping the +name of the index file, i.e., `00-index.tar.gz`, `01-index.tar.gz` etc. + + +[dist-simple]: ../release/cabal-latest/doc/API/Cabal/Distribution-Simple.html +[dist-make]: ../release/cabal-latest/doc/API/Cabal/Distribution-Make.html +[dist-license]: ../release/cabal-latest/doc/API/Cabal/Distribution-License.html#t:License +[extension]: ../release/cabal-latest/doc/API/Cabal/Language-Haskell-Extension.html#t:Extension +[BuildType]: ../release/cabal-latest/doc/API/Cabal/Distribution-PackageDescription.html#t:BuildType +[alex]: http://www.haskell.org/alex/ +[autoconf]: http://www.gnu.org/software/autoconf/ +[c2hs]: http://www.cse.unsw.edu.au/~chak/haskell/c2hs/ +[cpphs]: http://projects.haskell.org/cpphs/ +[greencard]: http://hackage.haskell.org/package/greencard +[haddock]: http://www.haskell.org/haddock/ +[HsColour]: http://www.cs.york.ac.uk/fp/darcs/hscolour/ +[happy]: http://www.haskell.org/happy/ +[Hackage]: http://hackage.haskell.org/ +[pkg-config]: http://www.freedesktop.org/wiki/Software/pkg-config/ diff --git a/tests/PackageTests.hs b/tests/PackageTests.hs --- a/tests/PackageTests.hs +++ b/tests/PackageTests.hs @@ -34,22 +34,23 @@ import PackageTests.TestStanza.Check import PackageTests.TestSuiteExeV10.Check import PackageTests.OrderFlags.Check +import PackageTests.ReexportedModules.Check -import Distribution.Compat.Exception (catchIO) +import Distribution.Simple.Configure + ( ConfigStateFileError(..), getConfigStateFile ) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..)) import Distribution.Simple.Program.Types (programPath) -import Distribution.Simple.Program.Builtin (ghcProgram, ghcPkgProgram, - haddockProgram) +import Distribution.Simple.Program.Builtin + ( ghcProgram, ghcPkgProgram, haddockProgram ) import Distribution.Simple.Program.Db (requireProgram) -import Distribution.Simple.Utils (cabalVersion, die, withFileContents) +import Distribution.Simple.Utils (cabalVersion) import Distribution.Text (display) import Distribution.Verbosity (normal) import Distribution.Version (Version(Version)) -import Data.Maybe (isJust) -import System.Directory (doesFileExist, getCurrentDirectory, - setCurrentDirectory) -import System.Environment (getEnv) +import Control.Exception (try, throw) +import System.Directory + ( getCurrentDirectory, setCurrentDirectory ) import System.FilePath (()) import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout) import Test.Framework (Test, TestName, defaultMain, testGroup) @@ -76,9 +77,7 @@ , hunit "TestStanza" (PackageTests.TestStanza.Check.suite ghcPath) -- ^ The Test stanza test will eventually be required -- only for higher versions. - , hunit "TestSuiteExeV10/Test" (PackageTests.TestSuiteExeV10.Check.checkTest ghcPath) - , hunit "TestSuiteExeV10/TestWithHpc" - (PackageTests.TestSuiteExeV10.Check.checkTestWithHpc ghcPath) + , testGroup "TestSuiteExeV10" (PackageTests.TestSuiteExeV10.Check.checks ghcPath) , hunit "TestOptions" (PackageTests.TestOptions.Check.suite ghcPath) , hunit "BenchmarkStanza" (PackageTests.BenchmarkStanza.Check.suite ghcPath) -- ^ The benchmark stanza test will eventually be required @@ -104,6 +103,8 @@ (PackageTests.OrderFlags.Check.suite ghcPath) , hunit "TemplateHaskell/dynamic" (PackageTests.TemplateHaskell.Check.dynamic ghcPath) + , hunit "ReexportedModules" + (PackageTests.ReexportedModules.Check.suite ghcPath) ] ++ -- These tests are only required to pass on cabal version >= 1.7 (if version >= Version [1, 7] [] @@ -139,6 +140,7 @@ , configOpts = [ "--package-db=" ++ dbFile , "--constraint=Cabal == " ++ display cabalVersion ] + , distPref = Nothing } putStrLn $ "Cabal test suite - testing cabal version " ++ display cabalVersion @@ -162,16 +164,9 @@ -- we run Cabal's own test suite, due to bootstrapping issues. getPersistBuildConfig_ :: FilePath -> IO LocalBuildInfo getPersistBuildConfig_ filename = do - exists <- doesFileExist filename - if not exists - then die missing - else withFileContents filename $ \str -> - case lines str of - [_header, rest] -> case reads rest of - [(bi,_)] -> return bi - _ -> die cantParse - _ -> die cantParse - where - missing = "Run the 'configure' command first." - cantParse = "Saved package config file seems to be corrupt. " - ++ "Try re-running the 'configure' command." + eLBI <- try $ getConfigStateFile filename + case eLBI of + Left (ConfigStateFileBadVersion _ _ (Right lbi)) -> return lbi + Left (ConfigStateFileBadVersion _ _ (Left err)) -> throw err + Left err -> throw err + Right lbi -> return lbi diff --git a/tests/PackageTests/BenchmarkExeV10/Check.hs b/tests/PackageTests/BenchmarkExeV10/Check.hs --- a/tests/PackageTests/BenchmarkExeV10/Check.hs +++ b/tests/PackageTests/BenchmarkExeV10/Check.hs @@ -11,6 +11,6 @@ checkBenchmark :: FilePath -> Test checkBenchmark ghcPath = TestCase $ do - let spec = PackageSpec dir ["--enable-benchmarks"] + let spec = PackageSpec dir Nothing ["--enable-benchmarks"] buildResult <- cabal_build spec ghcPath assertBuildSucceeded buildResult diff --git a/tests/PackageTests/BenchmarkOptions/Check.hs b/tests/PackageTests/BenchmarkOptions/Check.hs --- a/tests/PackageTests/BenchmarkOptions/Check.hs +++ b/tests/PackageTests/BenchmarkOptions/Check.hs @@ -6,8 +6,11 @@ suite :: FilePath -> Test suite ghcPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "BenchmarkOptions") - ["--enable-benchmarks"] + let spec = PackageSpec + { directory = "PackageTests" "BenchmarkOptions" + , configOpts = ["--enable-benchmarks"] + , distPref = Nothing + } _ <- cabal_build spec ghcPath result <- cabal_bench spec ["--benchmark-options=1 2 3"] ghcPath let message = "\"cabal bench\" did not pass the correct options to the " diff --git a/tests/PackageTests/BenchmarkStanza/Check.hs b/tests/PackageTests/BenchmarkStanza/Check.hs --- a/tests/PackageTests/BenchmarkStanza/Check.hs +++ b/tests/PackageTests/BenchmarkStanza/Check.hs @@ -2,6 +2,7 @@ import Test.HUnit import System.FilePath +import qualified Data.Map as Map import PackageTests.PackageTester import Distribution.Version import Distribution.PackageDescription.Parse @@ -14,28 +15,30 @@ ( PackageDescription(..), BuildInfo(..), Benchmark(..) , BenchmarkInterface(..) , emptyBuildInfo - , emptyBenchmark ) + , emptyBenchmark, defaultRenaming ) import Distribution.Verbosity (silent) import Distribution.System (buildPlatform) import Distribution.Compiler - ( CompilerId(..), CompilerFlavor(..) ) + ( CompilerId(..), CompilerFlavor(..), unknownCompilerInfo, AbiTag(..) ) import Distribution.Text suite :: FilePath -> Test suite ghcPath = TestCase $ do let dir = "PackageTests" "BenchmarkStanza" pdFile = dir "my" <.> "cabal" - spec = PackageSpec dir [] + spec = PackageSpec { directory = dir, configOpts = [], distPref = Nothing } result <- cabal_configure spec ghcPath assertOutputDoesNotContain "unknown section type" result genPD <- readPackageDescription silent pdFile - let compiler = CompilerId GHC $ Version [6, 12, 2] [] + let compiler = unknownCompilerInfo (CompilerId GHC $ Version [6, 12, 2] []) NoAbiTag anticipatedBenchmark = emptyBenchmark { benchmarkName = "dummy" , benchmarkInterface = BenchmarkExeV10 (Version [1,0] []) "dummy.hs" , benchmarkBuildInfo = emptyBuildInfo { targetBuildDepends = [ Dependency (PackageName "base") anyVersion ] + , targetBuildRenaming = + Map.singleton (PackageName "base") defaultRenaming , hsSourceDirs = ["."] } , benchmarkEnabled = False diff --git a/tests/PackageTests/BuildDeps/InternalLibrary0/Check.hs b/tests/PackageTests/BuildDeps/InternalLibrary0/Check.hs --- a/tests/PackageTests/BuildDeps/InternalLibrary0/Check.hs +++ b/tests/PackageTests/BuildDeps/InternalLibrary0/Check.hs @@ -9,7 +9,11 @@ suite :: Version -> FilePath -> Test suite cabalVersion ghcPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "BuildDeps" "InternalLibrary0") [] + let spec = PackageSpec + { directory = "PackageTests" "BuildDeps" "InternalLibrary0" + , configOpts = [] + , distPref = Nothing + } result <- cabal_build spec ghcPath assertBuildFailed result when (cabalVersion >= Version [1, 7] []) $ do diff --git a/tests/PackageTests/BuildDeps/InternalLibrary1/Check.hs b/tests/PackageTests/BuildDeps/InternalLibrary1/Check.hs --- a/tests/PackageTests/BuildDeps/InternalLibrary1/Check.hs +++ b/tests/PackageTests/BuildDeps/InternalLibrary1/Check.hs @@ -7,6 +7,10 @@ suite :: FilePath -> Test suite ghcPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "BuildDeps" "InternalLibrary1") [] + let spec = PackageSpec + { directory = "PackageTests" "BuildDeps" "InternalLibrary1" + , configOpts = [] + , distPref = Nothing + } result <- cabal_build spec ghcPath assertBuildSucceeded result diff --git a/tests/PackageTests/BuildDeps/InternalLibrary2/Check.hs b/tests/PackageTests/BuildDeps/InternalLibrary2/Check.hs --- a/tests/PackageTests/BuildDeps/InternalLibrary2/Check.hs +++ b/tests/PackageTests/BuildDeps/InternalLibrary2/Check.hs @@ -8,8 +8,16 @@ suite :: FilePath -> FilePath -> Test suite ghcPath ghcPkgPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "BuildDeps" "InternalLibrary2") [] - let specTI = PackageSpec (directory spec "to-install") [] + let spec = PackageSpec + { directory = "PackageTests" "BuildDeps" "InternalLibrary2" + , configOpts = [] + , distPref = Nothing + } + let specTI = PackageSpec + { directory = directory spec "to-install" + , configOpts = [] + , distPref = Nothing + } unregister "InternalLibrary2" ghcPkgPath iResult <- cabal_install specTI ghcPath @@ -18,7 +26,7 @@ assertBuildSucceeded bResult unregister "InternalLibrary2" ghcPkgPath - (_, _, output) <- run (Just $ directory spec) (directory spec "dist" "build" "lemon" "lemon") [] + (_, _, output) <- run (Just $ directory spec) (directory spec "dist" "build" "lemon" "lemon") [] [] C.appendFile (directory spec "test-log.txt") (C.pack $ "\ndist/build/lemon/lemon\n"++output) assertEqual "executable should have linked with the internal library" "myLibFunc internal" (concat $ lines output) diff --git a/tests/PackageTests/BuildDeps/InternalLibrary3/Check.hs b/tests/PackageTests/BuildDeps/InternalLibrary3/Check.hs --- a/tests/PackageTests/BuildDeps/InternalLibrary3/Check.hs +++ b/tests/PackageTests/BuildDeps/InternalLibrary3/Check.hs @@ -8,8 +8,16 @@ suite :: FilePath -> FilePath -> Test suite ghcPath ghcPkgPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "BuildDeps" "InternalLibrary3") [] - let specTI = PackageSpec (directory spec "to-install") [] + let spec = PackageSpec + { directory = "PackageTests" "BuildDeps" "InternalLibrary3" + , configOpts = [] + , distPref = Nothing + } + let specTI = PackageSpec + { directory = directory spec "to-install" + , configOpts = [] + , distPref = Nothing + } unregister "InternalLibrary3" ghcPkgPath iResult <- cabal_install specTI ghcPath @@ -18,7 +26,7 @@ assertBuildSucceeded bResult unregister "InternalLibrary3"ghcPkgPath - (_, _, output) <- run (Just $ directory spec) (directory spec "dist" "build" "lemon" "lemon") [] + (_, _, output) <- run (Just $ directory spec) (directory spec "dist" "build" "lemon" "lemon") [] [] C.appendFile (directory spec "test-log.txt") (C.pack $ "\ndist/build/lemon/lemon\n"++output) assertEqual "executable should have linked with the internal library" "myLibFunc internal" (concat $ lines output) diff --git a/tests/PackageTests/BuildDeps/InternalLibrary4/Check.hs b/tests/PackageTests/BuildDeps/InternalLibrary4/Check.hs --- a/tests/PackageTests/BuildDeps/InternalLibrary4/Check.hs +++ b/tests/PackageTests/BuildDeps/InternalLibrary4/Check.hs @@ -8,8 +8,16 @@ suite :: FilePath -> FilePath -> Test suite ghcPath ghcPkgPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "BuildDeps" "InternalLibrary4") [] - let specTI = PackageSpec (directory spec "to-install") [] + let spec = PackageSpec + { directory = "PackageTests" "BuildDeps" "InternalLibrary4" + , configOpts = [] + , distPref = Nothing + } + let specTI = PackageSpec + { directory = directory spec "to-install" + , configOpts = [] + , distPref = Nothing + } unregister "InternalLibrary4" ghcPkgPath iResult <- cabal_install specTI ghcPath @@ -18,7 +26,7 @@ assertBuildSucceeded bResult unregister "InternalLibrary4" ghcPkgPath - (_, _, output) <- run (Just $ directory spec) (directory spec "dist" "build" "lemon" "lemon") [] + (_, _, output) <- run (Just $ directory spec) (directory spec "dist" "build" "lemon" "lemon") [] [] C.appendFile (directory spec "test-log.txt") (C.pack $ "\ndist/build/lemon/lemon\n"++output) assertEqual "executable should have linked with the installed library" "myLibFunc installed" (concat $ lines output) diff --git a/tests/PackageTests/BuildDeps/SameDepsAllRound/Check.hs b/tests/PackageTests/BuildDeps/SameDepsAllRound/Check.hs --- a/tests/PackageTests/BuildDeps/SameDepsAllRound/Check.hs +++ b/tests/PackageTests/BuildDeps/SameDepsAllRound/Check.hs @@ -8,7 +8,11 @@ suite :: FilePath -> Test suite ghcPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "BuildDeps" "SameDepsAllRound") [] + let spec = PackageSpec + { directory = "PackageTests" "BuildDeps" "SameDepsAllRound" + , configOpts = [] + , distPref = Nothing + } result <- cabal_build spec ghcPath do assertEqual "cabal build should succeed - see test-log.txt" True (successful result) diff --git a/tests/PackageTests/BuildDeps/TargetSpecificDeps1/Check.hs b/tests/PackageTests/BuildDeps/TargetSpecificDeps1/Check.hs --- a/tests/PackageTests/BuildDeps/TargetSpecificDeps1/Check.hs +++ b/tests/PackageTests/BuildDeps/TargetSpecificDeps1/Check.hs @@ -10,7 +10,11 @@ suite :: FilePath -> Test suite ghcPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "BuildDeps" "TargetSpecificDeps1") [] + let spec = PackageSpec + { directory = "PackageTests" "BuildDeps" "TargetSpecificDeps1" + , configOpts = [] + , distPref = Nothing + } result <- cabal_build spec ghcPath do assertEqual "cabal build should fail - see test-log.txt" False (successful result) diff --git a/tests/PackageTests/BuildDeps/TargetSpecificDeps2/Check.hs b/tests/PackageTests/BuildDeps/TargetSpecificDeps2/Check.hs --- a/tests/PackageTests/BuildDeps/TargetSpecificDeps2/Check.hs +++ b/tests/PackageTests/BuildDeps/TargetSpecificDeps2/Check.hs @@ -8,7 +8,11 @@ suite :: FilePath -> Test suite ghcPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "BuildDeps" "TargetSpecificDeps2") [] + let spec = PackageSpec + { directory = "PackageTests" "BuildDeps" "TargetSpecificDeps2" + , configOpts = [] + , distPref = Nothing + } result <- cabal_build spec ghcPath do assertEqual "cabal build should succeed - see test-log.txt" True (successful result) diff --git a/tests/PackageTests/BuildDeps/TargetSpecificDeps3/Check.hs b/tests/PackageTests/BuildDeps/TargetSpecificDeps3/Check.hs --- a/tests/PackageTests/BuildDeps/TargetSpecificDeps3/Check.hs +++ b/tests/PackageTests/BuildDeps/TargetSpecificDeps3/Check.hs @@ -10,7 +10,11 @@ suite :: FilePath -> Test suite ghcPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "BuildDeps" "TargetSpecificDeps3") [] + let spec = PackageSpec + { directory = "PackageTests" "BuildDeps" "TargetSpecificDeps3" + , configOpts = [] + , distPref = Nothing + } result <- cabal_build spec ghcPath do assertEqual "cabal build should fail - see test-log.txt" False (successful result) diff --git a/tests/PackageTests/CMain/Check.hs b/tests/PackageTests/CMain/Check.hs --- a/tests/PackageTests/CMain/Check.hs +++ b/tests/PackageTests/CMain/Check.hs @@ -11,6 +11,10 @@ checkBuild :: FilePath -> Test checkBuild ghcPath = TestCase $ do - let spec = PackageSpec dir [] + let spec = PackageSpec + { directory = dir + , distPref = Nothing + , configOpts = [] + } buildResult <- cabal_build spec ghcPath assertBuildSucceeded buildResult diff --git a/tests/PackageTests/DeterministicAr/Check.hs b/tests/PackageTests/DeterministicAr/Check.hs --- a/tests/PackageTests/DeterministicAr/Check.hs +++ b/tests/PackageTests/DeterministicAr/Check.hs @@ -22,7 +22,7 @@ ghcPkg_field :: String -> String -> FilePath -> IO [FilePath] ghcPkg_field libraryName fieldName ghcPkgPath = do - (cmd, exitCode, raw) <- run Nothing ghcPkgPath + (cmd, exitCode, raw) <- run Nothing ghcPkgPath [] ["--user", "field", libraryName, fieldName] let output = filter ('\r' /=) raw -- Windows -- copypasta of PackageTester.requireSuccess @@ -51,7 +51,11 @@ suite :: FilePath -> FilePath -> Test suite ghcPath ghcPkgPath = TestCase $ do let dir = "PackageTests" this - let spec = PackageSpec dir [] + let spec = PackageSpec + { directory = dir + , configOpts = [] + , distPref = Nothing + } unregister this ghcPkgPath iResult <- cabal_install spec ghcPath diff --git a/tests/PackageTests/EmptyLib/Check.hs b/tests/PackageTests/EmptyLib/Check.hs --- a/tests/PackageTests/EmptyLib/Check.hs +++ b/tests/PackageTests/EmptyLib/Check.hs @@ -7,7 +7,10 @@ -- See https://github.com/haskell/cabal/issues/1241 emptyLib :: FilePath -> Test emptyLib ghcPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "EmptyLib" - "empty") [] + let spec = PackageSpec + { directory = "PackageTests" "EmptyLib" "empty" + , configOpts = [] + , distPref = Nothing + } result <- cabal_build spec ghcPath assertBuildSucceeded result diff --git a/tests/PackageTests/Haddock/Check.hs b/tests/PackageTests/Haddock/Check.hs --- a/tests/PackageTests/Haddock/Check.hs +++ b/tests/PackageTests/Haddock/Check.hs @@ -18,7 +18,11 @@ suite ghcPath = TestCase $ do let dir = "PackageTests" this haddocksDir = dir "dist" "doc" "html" "Haddock" - spec = PackageSpec dir [] + spec = PackageSpec + { directory = dir + , configOpts = [] + , distPref = Nothing + } haddocksDirExists <- doesDirectoryExist haddocksDir when haddocksDirExists (removeDirectoryRecursive haddocksDir) diff --git a/tests/PackageTests/OrderFlags/Check.hs b/tests/PackageTests/OrderFlags/Check.hs --- a/tests/PackageTests/OrderFlags/Check.hs +++ b/tests/PackageTests/OrderFlags/Check.hs @@ -11,7 +11,11 @@ suite :: FilePath -> Test suite ghcPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "OrderFlags") [] + let spec = PackageSpec + { directory = "PackageTests" "OrderFlags" + , configOpts = [] + , distPref = Nothing + } result <- cabal_build spec ghcPath do assertEqual "cabal build should succeed - see test-log.txt" True (successful result) diff --git a/tests/PackageTests/PackageTester.hs b/tests/PackageTests/PackageTester.hs --- a/tests/PackageTests/PackageTester.hs +++ b/tests/PackageTests/PackageTester.hs @@ -37,19 +37,21 @@ import System.Environment (getEnv) import System.Exit (ExitCode(ExitSuccess)) import System.FilePath -import System.IO +import System.IO (hIsEOF, hGetChar, hClose) import System.IO.Error (isDoesNotExistError) import System.Process (runProcess, waitForProcess) import Test.HUnit (Assertion, assertFailure) -import Distribution.Simple.BuildPaths (exeExtension) import Distribution.Compat.CreatePipe (createPipe) +import Distribution.Simple.BuildPaths (exeExtension) +import Distribution.Simple.Program.Run (getEffectiveEnvironment) +import Distribution.Simple.Utils (printRawCommandAndArgsAndEnv) import Distribution.ReadE (readEOrFail) -import Distribution.Verbosity (Verbosity, deafening, flagToVerbosity, normal, - verbose) +import Distribution.Verbosity (Verbosity, flagToVerbosity, normal) data PackageSpec = PackageSpec { directory :: FilePath + , distPref :: Maybe FilePath , configOpts :: [String] } @@ -92,9 +94,9 @@ doCabalConfigure :: PackageSpec -> FilePath -> IO Result doCabalConfigure spec ghcPath = do - cleanResult@(_, _, _) <- cabal spec ["clean"] ghcPath + cleanResult@(_, _, _) <- cabal spec [] ["clean"] ghcPath requireSuccess cleanResult - res <- cabal spec + res <- cabal spec [] (["configure", "--user", "-w", ghcPath] ++ configOpts spec) ghcPath return $ recordRun res ConfigureSuccess nullResult @@ -104,7 +106,7 @@ configResult <- doCabalConfigure spec ghcPath if successful configResult then do - res <- cabal spec ["build", "-v"] ghcPath + res <- cabal spec [] ["build", "-v"] ghcPath return $ recordRun res BuildSuccess configResult else return configResult @@ -126,14 +128,14 @@ configResult <- doCabalConfigure spec ghcPath if successful configResult then do - res <- cabal spec ("haddock" : extraArgs) ghcPath + res <- cabal spec [] ("haddock" : extraArgs) ghcPath return $ recordRun res HaddockSuccess configResult else return configResult unregister :: String -> FilePath -> IO () unregister libraryName ghcPkgPath = do - res@(_, _, output) <- run Nothing ghcPkgPath ["unregister", "--user", libraryName] + res@(_, _, output) <- run Nothing ghcPkgPath [] ["unregister", "--user", libraryName] if "cannot find package" `isInfixOf` output then return () else requireSuccess res @@ -144,23 +146,23 @@ buildResult <- doCabalBuild spec ghcPath res <- if successful buildResult then do - res <- cabal spec ["install"] ghcPath + res <- cabal spec [] ["install"] ghcPath return $ recordRun res InstallSuccess buildResult else return buildResult record spec res return res -cabal_test :: PackageSpec -> [String] -> FilePath -> IO Result -cabal_test spec extraArgs ghcPath = do - res <- cabal spec ("test" : extraArgs) ghcPath +cabal_test :: PackageSpec -> [(String, Maybe String)] -> [String] -> FilePath -> IO Result +cabal_test spec envOverrides extraArgs ghcPath = do + res <- cabal spec envOverrides ("test" : extraArgs) ghcPath let r = recordRun res TestSuccess nullResult record spec r return r cabal_bench :: PackageSpec -> [String] -> FilePath -> IO Result cabal_bench spec extraArgs ghcPath = do - res <- cabal spec ("bench" : extraArgs) ghcPath + res <- cabal spec [] ("bench" : extraArgs) ghcPath let r = recordRun res BenchSuccess nullResult record spec r return r @@ -168,7 +170,7 @@ compileSetup :: FilePath -> FilePath -> IO () compileSetup packageDir ghcPath = do wd <- getCurrentDirectory - r <- run (Just $ packageDir) ghcPath + r <- run (Just $ packageDir) ghcPath [] [ "--make" -- HPC causes trouble -- see #1012 -- , "-fhpc" @@ -178,30 +180,35 @@ requireSuccess r -- | Returns the command that was issued, the return code, and the output text. -cabal :: PackageSpec -> [String] -> FilePath -> IO (String, ExitCode, String) -cabal spec cabalArgs ghcPath = do +cabal :: PackageSpec -> [(String, Maybe String)] -> [String] -> FilePath -> IO (String, ExitCode, String) +cabal spec envOverrides cabalArgs_ ghcPath = do + let cabalArgs = case distPref spec of + Nothing -> cabalArgs_ + Just dist -> ("--builddir=" ++ dist) : cabalArgs_ customSetup <- doesFileExist (directory spec "Setup.hs") if customSetup then do compileSetup (directory spec) ghcPath path <- canonicalizePath $ directory spec "Setup" - run (Just $ directory spec) path cabalArgs + run (Just $ directory spec) path envOverrides cabalArgs else do -- Use shared Setup executable (only for Simple build types). path <- canonicalizePath "Setup" - run (Just $ directory spec) path cabalArgs + run (Just $ directory spec) path envOverrides cabalArgs --- | Returns the command that was issued, the return code, and hte output text -run :: Maybe FilePath -> String -> [String] -> IO (String, ExitCode, String) -run cwd path args = do +-- | Returns the command that was issued, the return code, and the output text +run :: Maybe FilePath -> String -> [(String, Maybe String)] -> [String] -> IO (String, ExitCode, String) +run cwd path envOverrides args = do verbosity <- getVerbosity -- path is relative to the current directory; canonicalizePath makes it -- absolute, so that runProcess will find it even when changing directory. path' <- do pathExists <- doesFileExist path canonicalizePath (if pathExists then path else path <.> exeExtension) - printRawCommandAndArgs verbosity path' args + menv <- getEffectiveEnvironment envOverrides + + printRawCommandAndArgsAndEnv verbosity path' args menv (readh, writeh) <- createPipe - pid <- runProcess path' args cwd Nothing Nothing (Just writeh) (Just writeh) + pid <- runProcess path' args cwd menv Nothing (Just writeh) (Just writeh) -- fork off a thread to start consuming the output out <- suckH [] readh @@ -220,12 +227,6 @@ c <- hGetChar h suckH (c:output) h --- Copied from Distribution/Simple/Utils.hs -printRawCommandAndArgs :: Verbosity -> FilePath -> [String] -> IO () -printRawCommandAndArgs verbosity path args - | verbosity >= deafening = print (path, args) - | verbosity >= verbose = putStrLn $ unwords (path : args) - | otherwise = return () requireSuccess :: (String, ExitCode, String) -> IO () requireSuccess (cmd, exitCode, output) = diff --git a/tests/PackageTests/PathsModule/Executable/Check.hs b/tests/PackageTests/PathsModule/Executable/Check.hs --- a/tests/PackageTests/PathsModule/Executable/Check.hs +++ b/tests/PackageTests/PathsModule/Executable/Check.hs @@ -7,7 +7,10 @@ suite :: FilePath -> Test suite ghcPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "PathsModule" "Executable") - [] + let spec = PackageSpec + { directory = "PackageTests" "PathsModule" "Executable" + , distPref = Nothing + , configOpts = [] + } result <- cabal_build spec ghcPath assertBuildSucceeded result diff --git a/tests/PackageTests/PathsModule/Library/Check.hs b/tests/PackageTests/PathsModule/Library/Check.hs --- a/tests/PackageTests/PathsModule/Library/Check.hs +++ b/tests/PackageTests/PathsModule/Library/Check.hs @@ -7,6 +7,10 @@ suite :: FilePath -> Test suite ghcPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "PathsModule" "Library") [] + let spec = PackageSpec + { directory = "PackageTests" "PathsModule" "Library" + , distPref = Nothing + , configOpts = [] + } result <- cabal_build spec ghcPath assertBuildSucceeded result diff --git a/tests/PackageTests/PreProcess/Check.hs b/tests/PackageTests/PreProcess/Check.hs --- a/tests/PackageTests/PreProcess/Check.hs +++ b/tests/PackageTests/PreProcess/Check.hs @@ -7,7 +7,10 @@ suite :: FilePath -> Test suite ghcPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "PreProcess") - ["--enable-tests", "--enable-benchmarks"] + let spec = PackageSpec + { directory = "PackageTests" "PreProcess" + , distPref = Nothing + , configOpts = ["--enable-tests", "--enable-benchmarks"] + } result <- cabal_build spec ghcPath assertBuildSucceeded result diff --git a/tests/PackageTests/TemplateHaskell/Check.hs b/tests/PackageTests/TemplateHaskell/Check.hs --- a/tests/PackageTests/TemplateHaskell/Check.hs +++ b/tests/PackageTests/TemplateHaskell/Check.hs @@ -6,8 +6,11 @@ vanilla :: FilePath -> Test vanilla ghcPath = TestCase $ do - let spec = PackageSpec ("PackageTests" - "TemplateHaskell" "vanilla") [] + let spec = PackageSpec + { directory = "PackageTests" "TemplateHaskell" "vanilla" + , configOpts = [] + , distPref = Nothing + } result <- cabal_build spec ghcPath assertBuildSucceeded result @@ -15,9 +18,12 @@ profiling ghcPath = TestCase $ do let flags = ["--enable-library-profiling" -- ,"--disable-library-vanilla" - ,"--enable-executable-profiling"] - spec = PackageSpec ("PackageTests" - "TemplateHaskell" "profiling") flags + ,"--enable-profiling"] + spec = PackageSpec + { directory = "PackageTests" "TemplateHaskell" "profiling" + , configOpts = flags + , distPref = Nothing + } result <- cabal_build spec ghcPath assertBuildSucceeded result @@ -26,7 +32,10 @@ let flags = ["--enable-shared" -- ,"--disable-library-vanilla" ,"--enable-executable-dynamic"] - spec = PackageSpec ("PackageTests" - "TemplateHaskell" "dynamic") flags + spec = PackageSpec + { directory = "PackageTests" "TemplateHaskell" "dynamic" + , configOpts = flags + , distPref = Nothing + } result <- cabal_build spec ghcPath assertBuildSucceeded result diff --git a/tests/PackageTests/TestOptions/Check.hs b/tests/PackageTests/TestOptions/Check.hs --- a/tests/PackageTests/TestOptions/Check.hs +++ b/tests/PackageTests/TestOptions/Check.hs @@ -6,17 +6,20 @@ suite :: FilePath -> Test suite ghcPath = TestCase $ do - let spec = PackageSpec ("PackageTests" "TestOptions") - ["--enable-tests"] + let spec = PackageSpec + { directory = "PackageTests" "TestOptions" + , configOpts = ["--enable-tests"] + , distPref = Nothing + } _ <- cabal_build spec ghcPath - result <- cabal_test spec ["--test-options=1 2 3"] ghcPath + result <- cabal_test spec [] ["--test-options=1 2 3"] ghcPath let message = "\"cabal test\" did not pass the correct options to the " ++ "test executable with \"--test-options\"" assertEqual message True $ successful result - result' <- cabal_test spec [ "--test-option=1" - , "--test-option=2" - , "--test-option=3" - ] + result' <- cabal_test spec [] [ "--test-option=1" + , "--test-option=2" + , "--test-option=3" + ] ghcPath let message' = "\"cabal test\" did not pass the correct options to the " ++ "test executable with \"--test-option\"" diff --git a/tests/PackageTests/TestStanza/Check.hs b/tests/PackageTests/TestStanza/Check.hs --- a/tests/PackageTests/TestStanza/Check.hs +++ b/tests/PackageTests/TestStanza/Check.hs @@ -2,6 +2,7 @@ import Test.HUnit import System.FilePath +import qualified Data.Map as Map import PackageTests.PackageTester import Distribution.Version import Distribution.PackageDescription.Parse (readPackageDescription) @@ -10,27 +11,35 @@ import Distribution.Package (PackageName(..), Dependency(..)) import Distribution.PackageDescription ( PackageDescription(..), BuildInfo(..), TestSuite(..) - , TestSuiteInterface(..), emptyBuildInfo, emptyTestSuite) + , TestSuiteInterface(..), emptyBuildInfo, emptyTestSuite + , defaultRenaming) import Distribution.Verbosity (silent) import Distribution.System (buildPlatform) -import Distribution.Compiler (CompilerId(..), CompilerFlavor(..)) +import Distribution.Compiler + ( CompilerId(..), CompilerFlavor(..), unknownCompilerInfo, AbiTag(..) ) import Distribution.Text suite :: FilePath -> Test suite ghcPath = TestCase $ do let dir = "PackageTests" "TestStanza" pdFile = dir "my" <.> "cabal" - spec = PackageSpec dir [] + spec = PackageSpec + { directory = dir + , configOpts = [] + , distPref = Nothing + } result <- cabal_configure spec ghcPath assertOutputDoesNotContain "unknown section type" result genPD <- readPackageDescription silent pdFile - let compiler = CompilerId GHC $ Version [6, 12, 2] [] + let compiler = unknownCompilerInfo (CompilerId GHC $ Version [6, 12, 2] []) NoAbiTag anticipatedTestSuite = emptyTestSuite { testName = "dummy" , testInterface = TestSuiteExeV10 (Version [1,0] []) "dummy.hs" , testBuildInfo = emptyBuildInfo { targetBuildDepends = [ Dependency (PackageName "base") anyVersion ] + , targetBuildRenaming = + Map.singleton (PackageName "base") defaultRenaming , hsSourceDirs = ["."] } , testEnabled = False diff --git a/tests/PackageTests/TestSuiteExeV10/Check.hs b/tests/PackageTests/TestSuiteExeV10/Check.hs --- a/tests/PackageTests/TestSuiteExeV10/Check.hs +++ b/tests/PackageTests/TestSuiteExeV10/Check.hs @@ -1,65 +1,138 @@ -module PackageTests.TestSuiteExeV10.Check - ( checkTest - , checkTestWithHpc - ) where +module PackageTests.TestSuiteExeV10.Check (checks) where -import Distribution.PackageDescription ( TestSuite(..), emptyTestSuite ) -import Distribution.Version ( Version(..), orLaterVersion ) -import Distribution.Simple.Hpc -import Distribution.Simple.Program.Builtin ( hpcProgram ) -import Distribution.Simple.Program.Db ( emptyProgramDb, configureProgram, - requireProgramVersion ) -import PackageTests.PackageTester -import qualified Control.Exception as E ( IOException, catch ) -import Control.Monad ( when ) -import System.Directory +import qualified Control.Exception as E (IOException, catch) +import Control.Monad (when) +import Data.Maybe (catMaybes) +import System.Directory ( doesFileExist ) import System.FilePath -import Test.HUnit +import qualified Test.Framework as TF +import Test.Framework (testGroup) +import Test.Framework.Providers.HUnit (hUnitTestToTests) +import Test.HUnit hiding ( path ) +import Distribution.Simple.Configure (getPersistBuildConfig) +import Distribution.Simple.Hpc +import Distribution.Simple.Program.Builtin (hpcProgram) +import Distribution.Simple.Program.Db + ( emptyProgramDb, configureProgram, requireProgramVersion ) import qualified Distribution.Verbosity as Verbosity +import Distribution.Version (Version(..), orLaterVersion) +import PackageTests.PackageTester + +checks :: FilePath -> [TF.Test] +checks ghcPath = + [ hunit "Test" $ checkTest ghcPath ] + ++ hpcTestMatrix ghcPath ++ + [ hunit "TestNoHpc/NoTix" $ checkTestNoHpcNoTix ghcPath + , hunit "TestNoHpc/NoMarkup" $ checkTestNoHpcNoMarkup ghcPath + ] + +hpcTestMatrix :: FilePath -> [TF.Test] +hpcTestMatrix ghcPath = do + libProf <- [True, False] + exeProf <- [True, False] + exeDyn <- [True, False] + shared <- [True, False] + let name = concat + [ "WithHpc-" + , if libProf then "LibProf" else "" + , if exeProf then "ExeProf" else "" + , if exeDyn then "ExeDyn" else "" + , if shared then "Shared" else "" + ] + enable cond flag + | cond = Just $ "--enable-" ++ flag + | otherwise = Nothing + opts = catMaybes + [ enable libProf "library-profiling" + , enable exeProf "profiling" + , enable exeDyn "executable-dynamic" + , enable shared "shared" + ] + return $ hunit name $ checkTestWithHpc ghcPath name opts + dir :: FilePath dir = "PackageTests" "TestSuiteExeV10" checkTest :: FilePath -> Test -checkTest ghcPath = TestCase $ do - let spec = PackageSpec dir ["--enable-tests"] +checkTest ghcPath = TestCase $ buildAndTest ghcPath "Default" [] [] + +shouldExist :: FilePath -> Assertion +shouldExist path = doesFileExist path >>= assertBool (path ++ " should exist") + +shouldNotExist :: FilePath -> Assertion +shouldNotExist path = + doesFileExist path >>= assertBool (path ++ " should exist") . not + +-- | Ensure that both .tix file and markup are generated if coverage is enabled. +checkTestWithHpc :: FilePath -> String -> [String] -> Test +checkTestWithHpc ghcPath name extraOpts = TestCase $ do + isCorrectVersion <- correctHpcVersion + when isCorrectVersion $ do + buildAndTest ghcPath name [] ("--enable-coverage" : extraOpts) + lbi <- getPersistBuildConfig (dir "dist-" ++ name) + let way = guessWay lbi + mapM_ shouldExist + [ mixDir (dir "dist-" ++ name) way "my-0.1" + "my-0.1" "Foo.mix" + , mixDir (dir "dist-" ++ name) way "test-Foo" "Main.mix" + , tixFilePath (dir "dist-" ++ name) way "test-Foo" + , htmlDir (dir "dist-" ++ name) way "test-Foo" + "hpc_index.html" + ] + +-- | Ensures that even if -fhpc is manually provided no .tix file is output. +checkTestNoHpcNoTix :: FilePath -> Test +checkTestNoHpcNoTix ghcPath = TestCase $ do + buildAndTest ghcPath "NoHpcNoTix" [] + [ "--ghc-option=-fhpc" + , "--ghc-option=-hpcdir" + , "--ghc-option=dist-NoHpcNoTix/hpc/vanilla" ] + lbi <- getPersistBuildConfig (dir "dist-NoHpcNoTix") + let way = guessWay lbi + shouldNotExist $ tixFilePath (dir "dist-NoHpcNoTix") way "test-Foo" + +-- | Ensures that even if a .tix file happens to be left around +-- markup isn't generated. +checkTestNoHpcNoMarkup :: FilePath -> Test +checkTestNoHpcNoMarkup ghcPath = TestCase $ do + let tixFile = tixFilePath "dist-NoHpcNoMarkup" Vanilla "test-Foo" + buildAndTest ghcPath "NoHpcNoMarkup" + [("HPCTIXFILE", Just tixFile)] + [ "--ghc-option=-fhpc" + , "--ghc-option=-hpcdir" + , "--ghc-option=dist-NoHpcNoMarkup/hpc/vanilla" ] + shouldNotExist $ htmlDir (dir "dist-NoHpcNoMarkup") Vanilla "test-Foo" "hpc_index.html" + +-- | Build and test a package and ensure that both were successful. +-- +-- The flag "--enable-tests" is provided in addition to the given flags. +buildAndTest :: FilePath -> String -> [(String, Maybe String)] -> [String] -> IO () +buildAndTest ghcPath name envOverrides flags = do + let spec = PackageSpec + { directory = dir + , distPref = Just $ "dist-" ++ name + , configOpts = "--enable-tests" : flags + } buildResult <- cabal_build spec ghcPath assertBuildSucceeded buildResult - testResult <- cabal_test spec [] ghcPath + testResult <- cabal_test spec envOverrides [] ghcPath assertTestSucceeded testResult -checkTestWithHpc :: FilePath -> Test -checkTestWithHpc ghcPath = TestCase $ do - isCorrectVersion <- checkHpcVersion - when isCorrectVersion $ do - let spec = PackageSpec dir [ "--enable-tests" - , "--enable-library-coverage" - ] - buildResult <- cabal_build spec ghcPath - assertBuildSucceeded buildResult - testResult <- cabal_test spec [] ghcPath - assertTestSucceeded testResult - let dummy = emptyTestSuite { testName = "test-Foo" } - tixFile = tixFilePath (dir "dist") $ testName dummy - tixFileMessage = ".tix file should exist" - markupDir = htmlDir (dir "dist") $ testName dummy - markupFile = markupDir "hpc_index" <.> "html" - markupFileMessage = "HPC markup file should exist" - tixFileExists <- doesFileExist tixFile - assertEqual tixFileMessage True tixFileExists - markupFileExists <- doesFileExist markupFile - assertEqual markupFileMessage True markupFileExists - where - checkHpcVersion :: IO Bool - checkHpcVersion = do - let programDb' = emptyProgramDb - let verbosity = Verbosity.normal - let verRange = orLaterVersion (Version [0,7] []) - programDb <- configureProgram verbosity hpcProgram programDb' - (requireProgramVersion verbosity hpcProgram verRange programDb - >> return True) `catchIO` (\_ -> return False) +hunit :: TF.TestName -> Test -> TF.Test +hunit name = testGroup name . hUnitTestToTests - -- Distirubution.Compat.Exception is hidden. +-- | Checks for a suitable HPC version for testing. +correctHpcVersion :: IO Bool +correctHpcVersion = do + let programDb' = emptyProgramDb + let verbosity = Verbosity.normal + let verRange = orLaterVersion (Version [0,7] []) + programDb <- configureProgram verbosity hpcProgram programDb' + (requireProgramVersion verbosity hpcProgram verRange programDb + >> return True) `catchIO` (\_ -> return False) + where + -- Distribution.Compat.Exception is hidden. catchIO :: IO a -> (E.IOException -> IO a) -> IO a catchIO = E.catch diff --git a/tests/README b/tests/README deleted file mode 100644 --- a/tests/README +++ /dev/null @@ -1,22 +0,0 @@ -Writing Package Tests -===================== - -The tests under the `PackageTests` directory define and build packages which -exercise various components of Cabal. Each test case is an `HUnit` test. The -entry point for the test suite, where all the test cases are listed, is -`PackageTests.hs`. There are utilities for calling the stages of Cabal's build -process in `PackageTests/PackageTester.hs`; have a look at an existing test case -to see how they're used. - -It is very important that package tests use the in-place version of Cabal, -rather than the system version. Several long-standing bugs in the test suite -were caused by testing the system (rather than the newly-compiled) version of -Cabal. There are two places where the system Cabal can accidentally be invoked: -1. Compiling `Setup.hs`. `runghc` needs to be told about the in-place package -database. This issue should be solved for all future package tests; see -`compileSetup` in `PackageTests/PackageTester.hs`. -2. Compiling a package which depends on Cabal. In particular, packages with -`detailed` type test suites depend on the Cabal library directly, so it is -important that they are configured to use the in-place package database. The -test suite already creates a stub `PackageSpec` for this case; see -`PackageTests/BuildTestSuiteDetailedV09/Check.hs` to see how it is used. diff --git a/tests/README.md b/tests/README.md new file mode 100644 --- /dev/null +++ b/tests/README.md @@ -0,0 +1,34 @@ +Writing package tests +===================== + +The tests under the [PackageTests] directory define and build packages +that exercise various components of Cabal. Each test case is an [HUnit] +test. The entry point for the test suite, where all the test cases are +listed, is [PackageTests.hs]. There are utilities for calling the stages +of Cabal's build process in [PackageTests/PackageTester.hs]; have a look +at an existing test case to see how they are used. + +It is important that package tests use the in-place version of Cabal +rather than the system version. Several long-standing bugs in the test +suite were caused by testing the system (rather than the newly compiled) +version of Cabal. There are two places where the system Cabal can +accidentally be invoked: + +1. Compiling `Setup.hs`. `runghc` needs to be told about the in-place + package database. This issue should be solved for all future package + tests; see `compileSetup` in [PackageTests/PackageTester.hs]. + +2. Compiling a package which depends on Cabal. In particular, packages + with the [detailed]-type test suites depend on the Cabal library + directly, so it is important that they are configured to use the + in-place package database. The test suite already creates a stub + `PackageSpec` for this case; see + [PackageTests/BuildTestSuiteDetailedV09/Check.hs] to see how it is + used. + +[PackageTests]: PackageTests +[HUnit]: http://hackage.haskell.org/package/HUnit +[PackageTests.hs]: PackageTests.hs +[PackageTests/PackageTester.hs]: PackageTests/PackageTester.hs +[detailed]: ../Distribution/TestSuite.hs +[PackageTests/BuildTestSuiteDetailedV09/Check.hs]: PackageTests/BuildTestSuiteDetailedV09/Check.hs diff --git a/tests/UnitTests.hs b/tests/UnitTests.hs --- a/tests/UnitTests.hs +++ b/tests/UnitTests.hs @@ -5,12 +5,18 @@ import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout) import Test.Framework +import qualified UnitTests.Distribution.Compat.CreatePipe import qualified UnitTests.Distribution.Compat.ReadP +import qualified UnitTests.Distribution.Utils.NubList tests :: [Test] -tests = [ - testGroup "Distribution.Compat.ReadP" +tests = + [ testGroup "Distribution.Compat.ReadP" UnitTests.Distribution.Compat.ReadP.tests + , testGroup "Distribution.Compat.CreatePipe" + UnitTests.Distribution.Compat.CreatePipe.tests + , testGroup "Distribution.Utils.NubList" + UnitTests.Distribution.Utils.NubList.tests ] main :: IO () diff --git a/tests/UnitTests/Distribution/Compat/CreatePipe.hs b/tests/UnitTests/Distribution/Compat/CreatePipe.hs new file mode 100644 --- /dev/null +++ b/tests/UnitTests/Distribution/Compat/CreatePipe.hs @@ -0,0 +1,20 @@ +module UnitTests.Distribution.Compat.CreatePipe (tests) where + +import Distribution.Compat.CreatePipe +import System.IO (hClose, hGetContents, hPutStr, hSetEncoding, localeEncoding) +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) + +tests :: [Test] +tests = [testCase "Locale Encoding" case_Locale_Encoding] + +case_Locale_Encoding :: Assertion +case_Locale_Encoding = assert $ do + let str = "\0252" + (r, w) <- createPipe + hSetEncoding w localeEncoding + out <- hGetContents r + hPutStr w str + hClose w + return $! out == str diff --git a/tests/UnitTests/Distribution/Utils/NubList.hs b/tests/UnitTests/Distribution/Utils/NubList.hs new file mode 100644 --- /dev/null +++ b/tests/UnitTests/Distribution/Utils/NubList.hs @@ -0,0 +1,44 @@ +module UnitTests.Distribution.Utils.NubList + ( tests + ) where + +import Data.Monoid +import Distribution.Utils.NubList +import Test.Framework +import Test.Framework.Providers.HUnit (testCase) +import Test.Framework.Providers.QuickCheck2 +import Test.HUnit (Assertion, assertBool) + +tests :: [Test] +tests = + [ testCase "Numlist retains ordering" testOrdering + , testCase "Numlist removes duplicates" testDeDupe + , testProperty "Monoid Numlist Identity" prop_Identity + , testProperty "Monoid Numlist Associativity" prop_Associativity + ] + +someIntList :: [Int] +-- This list must not have duplicate entries. +someIntList = [ 1, 3, 4, 2, 0, 7, 6, 5, 9, -1 ] + +testOrdering :: Assertion +testOrdering = + assertBool "Maintains element ordering:" $ + fromNubList (toNubList someIntList) == someIntList + +testDeDupe :: Assertion +testDeDupe = + assertBool "De-duplicates a list:" $ + fromNubList (toNubList (someIntList ++ someIntList)) == someIntList + +-- --------------------------------------------------------------------------- +-- QuickCheck properties for NubList + +prop_Identity :: [Int] -> Bool +prop_Identity xs = + mempty `mappend` toNubList xs == toNubList xs `mappend` mempty + +prop_Associativity :: [Int] -> [Int] -> [Int] -> Bool +prop_Associativity xs ys zs = + (toNubList xs `mappend` toNubList ys) `mappend` toNubList zs + == toNubList xs `mappend` (toNubList ys `mappend` toNubList zs)