diff --git a/Cabal.cabal b/Cabal.cabal
--- a/Cabal.cabal
+++ b/Cabal.cabal
@@ -1,5 +1,5 @@
name: Cabal
-version: 1.18.1.7
+version: 1.20.0.0
copyright: 2003-2006, Isaac Jones
2005-2011, Duncan Coutts
license: BSD3
@@ -19,19 +19,14 @@
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
- -- Generated with
- --
- -- find tests -type f -name '*.hs' -or -name '*.c' -or -name '*.sh' -or -name '*.cabal' -or name '*.hsc'
- -- | awk '/Check.hs$|UnitTests|PackageTester|autogen|PackageTests.hs|CreatePipe/
- -- { next } { print }'
-
+ -- Generated with 'misc/gen-extra-source-files.sh' & 'M-x sort-lines':
tests/PackageTests/BenchmarkExeV10/Foo.hs
tests/PackageTests/BenchmarkExeV10/benchmarks/bench-Foo.hs
tests/PackageTests/BenchmarkExeV10/my.cabal
@@ -82,12 +77,9 @@
tests/PackageTests/CMain/Setup.hs
tests/PackageTests/CMain/foo.c
tests/PackageTests/CMain/my.cabal
+ tests/PackageTests/DeterministicAr/Lib.hs
+ tests/PackageTests/DeterministicAr/my.cabal
tests/PackageTests/EmptyLib/empty/empty.cabal
- tests/PackageTests/Haddock/CPP.hs
- tests/PackageTests/Haddock/Literate.lhs
- tests/PackageTests/Haddock/my.cabal
- tests/PackageTests/Haddock/NoCPP.hs
- tests/PackageTests/Haddock/Simple.hs
tests/PackageTests/OrderFlags/Foo.hs
tests/PackageTests/OrderFlags/my.cabal
tests/PackageTests/PathsModule/Executable/Main.hs
@@ -96,10 +88,6 @@
tests/PackageTests/PreProcess/Foo.hsc
tests/PackageTests/PreProcess/Main.hs
tests/PackageTests/PreProcess/my.cabal
- tests/PackageTests/TemplateHaskell/vanilla/Exe.hs
- tests/PackageTests/TemplateHaskell/vanilla/Lib.hs
- tests/PackageTests/TemplateHaskell/vanilla/TH.hs
- tests/PackageTests/TemplateHaskell/vanilla/my.cabal
tests/PackageTests/TemplateHaskell/dynamic/Exe.hs
tests/PackageTests/TemplateHaskell/dynamic/Lib.hs
tests/PackageTests/TemplateHaskell/dynamic/TH.hs
@@ -108,6 +96,10 @@
tests/PackageTests/TemplateHaskell/profiling/Lib.hs
tests/PackageTests/TemplateHaskell/profiling/TH.hs
tests/PackageTests/TemplateHaskell/profiling/my.cabal
+ tests/PackageTests/TemplateHaskell/vanilla/Exe.hs
+ tests/PackageTests/TemplateHaskell/vanilla/Lib.hs
+ tests/PackageTests/TemplateHaskell/vanilla/TH.hs
+ tests/PackageTests/TemplateHaskell/vanilla/my.cabal
tests/PackageTests/TestOptions/TestOptions.cabal
tests/PackageTests/TestOptions/test-TestOptions.hs
tests/PackageTests/TestStanza/my.cabal
@@ -128,11 +120,11 @@
library
build-depends:
base >= 4 && < 5,
- deepseq >= 1.3 && < 1.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.6,
+ time >= 1.1 && < 1.5,
containers >= 0.1 && < 0.6,
array >= 0.1 && < 0.6,
pretty >= 1 && < 1.2,
@@ -145,6 +137,7 @@
ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs
exposed-modules:
+ Distribution.Compat.CreatePipe
Distribution.Compat.Environment
Distribution.Compat.Exception
Distribution.Compat.ReadP
@@ -175,6 +168,7 @@
Distribution.Simple.Configure
Distribution.Simple.GHC
Distribution.Simple.Haddock
+ Distribution.Simple.HaskellSuite
Distribution.Simple.Hpc
Distribution.Simple.Hugs
Distribution.Simple.Install
@@ -197,11 +191,15 @@
Distribution.Simple.Program.Ld
Distribution.Simple.Program.Run
Distribution.Simple.Program.Script
+ Distribution.Simple.Program.Strip
Distribution.Simple.Program.Types
Distribution.Simple.Register
Distribution.Simple.Setup
Distribution.Simple.SrcDist
Distribution.Simple.Test
+ Distribution.Simple.Test.ExeV10
+ Distribution.Simple.Test.LibV09
+ Distribution.Simple.Test.Log
Distribution.Simple.UHC
Distribution.Simple.UserHooks
Distribution.Simple.Utils
@@ -235,7 +233,7 @@
test-framework-hunit,
test-framework-quickcheck2,
HUnit,
- QuickCheck,
+ QuickCheck < 2.7,
Cabal
ghc-options: -Wall
default-language: Haskell98
@@ -245,7 +243,6 @@
type: exitcode-stdio-1.0
main-is: PackageTests.hs
other-modules:
- Distribution.Compat.CreatePipe
PackageTests.BenchmarkExeV10.Check
PackageTests.BenchmarkOptions.Check
PackageTests.BenchmarkStanza.Check
@@ -262,8 +259,8 @@
PackageTests.BuildDeps.TargetSpecificDeps3.Check
PackageTests.BuildTestSuiteDetailedV09.Check
PackageTests.CMain.Check
+ PackageTests.DeterministicAr.Check
PackageTests.EmptyLib.Check
- PackageTests.Haddock.Check
PackageTests.OrderFlags.Check
PackageTests.PackageTester
PackageTests.PathsModule.Executable.Check
@@ -280,7 +277,7 @@
test-framework-quickcheck2 >= 0.2.12,
test-framework-hunit,
HUnit,
- QuickCheck >= 2.1.0.1,
+ QuickCheck >= 2.1.0.1 && < 2.7,
Cabal,
process,
directory,
diff --git a/Distribution/Compat/CopyFile.hs b/Distribution/Compat/CopyFile.hs
--- a/Distribution/Compat/CopyFile.hs
+++ b/Distribution/Compat/CopyFile.hs
@@ -2,6 +2,8 @@
{-# OPTIONS_HADDOCK hide #-}
module Distribution.Compat.CopyFile (
copyFile,
+ copyFileChanged,
+ filesEqual,
copyOrdinaryFile,
copyExecutableFile,
setFileOrdinary,
@@ -11,21 +13,23 @@
import Control.Monad
- ( when )
+ ( when, unless )
import Control.Exception
( bracket, bracketOnError, throwIO )
+import qualified Data.ByteString.Lazy as BSL
import Distribution.Compat.Exception
( catchIO )
import System.IO.Error
( ioeSetLocation )
import System.Directory
- ( renameFile, removeFile )
+ ( doesFileExist, renameFile, removeFile )
import Distribution.Compat.TempFile
( openBinaryTempFile )
import System.FilePath
( takeDirectory )
import System.IO
- ( openBinaryFile, IOMode(ReadMode), hClose, hGetBuf, hPutBuf )
+ ( openBinaryFile, IOMode(ReadMode), hClose, hGetBuf, hPutBuf
+ , withBinaryFile )
import Foreign
( allocaBytes )
@@ -59,6 +63,8 @@
-- This happens to be true on Unix and currently on Windows too:
setDirOrdinary = setFileExecutable
+-- | Copies a file to a new destination.
+-- Often you should use `copyFileChanged` instead.
copyFile :: FilePath -> FilePath -> IO ()
copyFile fromFPath toFPath =
copy
@@ -79,3 +85,25 @@
when (count > 0) $ do
hPutBuf hTo buffer count
copyContents hFrom hTo buffer
+
+-- | Like `copyFile`, but does not touch the target if source and destination
+-- are already byte-identical. This is recommended as it is useful for
+-- time-stamp based recompilation avoidance.
+copyFileChanged :: FilePath -> FilePath -> IO ()
+copyFileChanged src dest = do
+ equal <- filesEqual src dest
+ unless equal $ copyFile src dest
+
+-- | Checks if two files are byte-identical.
+-- Returns False if either of the files do not exist.
+filesEqual :: FilePath -> FilePath -> IO Bool
+filesEqual f1 f2 = do
+ ex1 <- doesFileExist f1
+ ex2 <- doesFileExist f2
+ if not (ex1 && ex2) then return False else do
+
+ withBinaryFile f1 ReadMode $ \h1 ->
+ withBinaryFile f2 ReadMode $ \h2 -> do
+ c1 <- BSL.hGetContents h1
+ c2 <- BSL.hGetContents h2
+ return $! c1 == c2
diff --git a/Distribution/Compat/CreatePipe.hs b/Distribution/Compat/CreatePipe.hs
new file mode 100644
--- /dev/null
+++ b/Distribution/Compat/CreatePipe.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+module Distribution.Compat.CreatePipe (createPipe, tee) where
+
+import Control.Concurrent (forkIO)
+import Control.Monad (forM_, when)
+import System.IO (Handle, hClose, hGetContents, hPutStr)
+
+-- The mingw32_HOST_OS CPP macro is GHC-specific
+#if mingw32_HOST_OS
+import Control.Exception (onException)
+import Foreign.C.Error (throwErrnoIfMinus1_)
+import Foreign.C.Types (CInt(..), CUInt(..))
+import Foreign.Ptr (Ptr)
+import Foreign.Marshal.Array (allocaArray)
+import Foreign.Storable (peek, peekElemOff)
+import GHC.IO.FD (mkFD)
+import GHC.IO.Device (IODeviceType(Stream))
+import GHC.IO.Handle.FD (mkHandleFromFD)
+import System.IO (IOMode(ReadMode, WriteMode))
+#else
+import System.Posix.IO (fdToHandle)
+import qualified System.Posix.IO as Posix
+#endif
+
+createPipe :: IO (Handle, Handle)
+-- The mingw32_HOST_OS CPP macro is GHC-specific
+#if mingw32_HOST_OS
+createPipe = do
+ (readfd, writefd) <- allocaArray 2 $ \ pfds -> do
+ throwErrnoIfMinus1_ "_pipe" $ c__pipe pfds 2 ({- _O_BINARY -} 32768)
+ readfd <- peek pfds
+ writefd <- peekElemOff pfds 1
+ return (readfd, writefd)
+ (do readh <- fdToHandle readfd ReadMode
+ writeh <- fdToHandle writefd WriteMode
+ return (readh, writeh)) `onException` (close readfd >> close writefd)
+ where
+ fdToHandle :: CInt -> IOMode -> IO Handle
+ fdToHandle fd mode = do
+ (fd', deviceType) <- mkFD fd mode (Just (Stream, 0, 0)) False False
+ mkHandleFromFD fd' deviceType "" mode False Nothing
+
+ close :: CInt -> IO ()
+ close = throwErrnoIfMinus1_ "_close" . c__close
+
+foreign import ccall "io.h _pipe" c__pipe ::
+ Ptr CInt -> CUInt -> CInt -> IO CInt
+
+foreign import ccall "io.h _close" c__close ::
+ CInt -> IO CInt
+#else
+createPipe = do
+ (readfd, writefd) <- Posix.createPipe
+ readh <- fdToHandle readfd
+ writeh <- fdToHandle writefd
+ return (readh, writeh)
+#endif
+
+-- | Copy the contents of the input handle to the output handles, like
+-- the Unix command. The input handle is processed in another thread until
+-- EOF is reached; 'tee' returns immediately. The 'Bool' with each output
+-- handle indicates if it should be closed when EOF is reached.
+-- Synchronization can be achieved by blocking on an output handle.
+tee :: Handle -- ^ input
+ -> [(Handle, Bool)] -- ^ output, close?
+ -> IO ()
+tee inH outHs = do
+ -- 'hGetContents' might cause text decoding errors on binary streams that
+ -- are not text. It might be better to read into a buffer with 'hGetBuf'
+ -- that does no text decoding, but that seems to block all threads on
+ -- Windows. This is much simpler.
+ str <- hGetContents inH
+ forM_ outHs $ \(h, close) -> forkIO $ do
+ hPutStr h str
+ when close $ hClose h
diff --git a/Distribution/Compat/ReadP.hs b/Distribution/Compat/ReadP.hs
--- a/Distribution/Compat/ReadP.hs
+++ b/Distribution/Compat/ReadP.hs
@@ -392,6 +392,3 @@
-- parser, and therefore a possible inefficiency.
readS_to_P r =
R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s']))
-
-
-
diff --git a/Distribution/Compat/TempFile.hs b/Distribution/Compat/TempFile.hs
--- a/Distribution/Compat/TempFile.hs
+++ b/Distribution/Compat/TempFile.hs
@@ -37,7 +37,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: Not sure about JHC
-- This is a copy/paste of the openBinaryTempFile definition, but
-- if uses 666 rather than 600 for the permissions. The base library
@@ -49,7 +49,7 @@
where
-- We split off the last extension, so we can use .foo.ext files
-- for temporary files (hidden on Unix OSes). Unfortunately we're
- -- below filepath in the hierarchy here.
+ -- below file path in the hierarchy here.
(prefix,suffix) =
case break (== '.') $ reverse template of
-- First case: template contains no '.'s. Just re-reverse it.
@@ -76,9 +76,9 @@
then findTempName (x+1)
else ioError (errnoToIOError "openNewBinaryFile" errno Nothing (Just dir))
else do
- -- TODO: We want to tell fdToHandle what the filepath is,
+ -- TODO: We want to tell fdToHandle what the file path is,
-- as any exceptions etc will only be able to report the
- -- fd currently
+ -- FD currently
h <- fdToHandle fd `onException` c_close fd
return (filepath, h)
where
@@ -92,7 +92,7 @@
| last a == pathSeparator = a ++ b
| otherwise = a ++ [pathSeparator] ++ b
--- FIXME: Should use filepath library
+-- FIXME: Should use System.FilePath library
pathSeparator :: Char
#ifdef mingw32_HOST_OS
pathSeparator = '\\'
diff --git a/Distribution/Compiler.hs b/Distribution/Compiler.hs
--- a/Distribution/Compiler.hs
+++ b/Distribution/Compiler.hs
@@ -3,6 +3,7 @@
-- |
-- Module : Distribution.Compiler
-- Copyright : Isaac Jones 2003-2004
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -22,36 +23,6 @@
-- moment we just have to live with this deficiency. If you're interested, see
-- ticket #57.
-{- 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 Isaac Jones 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. -}
-
module Distribution.Compiler (
-- * Compiler flavor
CompilerFlavor(..),
@@ -79,6 +50,7 @@
import Control.Monad (when)
data CompilerFlavor = GHC | 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)
@@ -87,6 +59,7 @@
instance Text CompilerFlavor where
disp (OtherCompiler name) = Disp.text name
+ disp (HaskellSuite name) = Disp.text name
disp NHC = Disp.text "nhc98"
disp other = Disp.text (lowercase (show other))
diff --git a/Distribution/InstalledPackageInfo.hs b/Distribution/InstalledPackageInfo.hs
--- a/Distribution/InstalledPackageInfo.hs
+++ b/Distribution/InstalledPackageInfo.hs
@@ -75,7 +75,8 @@
, parseFreeText, showFreeText )
import Distribution.License ( License(..) )
import Distribution.Package
- ( PackageName(..), PackageIdentifier(..), PackageId, InstalledPackageId(..)
+ ( PackageName(..), PackageIdentifier(..)
+ , PackageId, InstalledPackageId(..)
, packageName, packageVersion )
import qualified Distribution.Package as Package
( Package(..) )
diff --git a/Distribution/License.hs b/Distribution/License.hs
--- a/Distribution/License.hs
+++ b/Distribution/License.hs
@@ -2,51 +2,43 @@
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.License
+-- Description : The License data type.
-- Copyright : Isaac Jones 2003-2005
-- Duncan Coutts 2008
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
--- The License datatype. For more information about these and other
--- open-source licenses, you may visit .
+-- Package descriptions contain fields for specifying the name of a software
+-- license and the name of the file containing the text of that license. While
+-- package authors may choose any license they like, Cabal provides an
+-- enumeration of a small set of common free and open source software licenses.
+-- This is done so that Hackage can recognise licenses, so that tools can detect
+-- ,
+-- and to deter
+-- .
--
--- The @.cabal@ file allows you to specify a license file. Of course you can
--- use any license you like but people often pick common open source licenses
--- and it's useful if we can automatically recognise that (eg so we can display
--- it on the hackage web pages). So you can also specify the license itself in
--- the @.cabal@ file from a short enumeration defined in this module. It
--- includes 'GPL', 'AGPL', 'LGPL', 'Apache 2.0', 'MIT' and 'BSD3' licenses.
-
-{- 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 Isaac Jones 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. -}
+-- It is recommended that all package authors use the @license-file@ or
+-- @license-files@ fields in their package descriptions. Further information
+-- about these fields can be found in the
+-- .
+--
+-- = Additional resources
+--
+-- The following websites provide information about free and open source
+-- software licenses:
+--
+-- *
+--
+-- *
+--
+-- = Disclaimer
+--
+-- The descriptions of software licenses provided by this documentation are
+-- intended for informational purposes only and in no way constitute legal
+-- advice. Please read the text of the licenses and consult a lawyer for any
+-- advice regarding software licensing.
module Distribution.License (
License(..),
@@ -63,62 +55,70 @@
import Data.Data (Data)
import Data.Typeable (Typeable)
--- |This datatype indicates the license under which your package is
--- released. It is also wise to add your license to each source file
--- using the license-file field. The 'AllRightsReserved' constructor
--- is not actually a license, but states that you are not giving
--- anyone else a license to use or distribute your work. The comments
--- below are general guidelines. Please read the licenses themselves
--- and consult a lawyer if you are unsure of your rights to release
--- the software.
---
+-- | 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
+-- cause @cabal check@ to issue a warning.
data License =
-
---TODO: * remove BSD4
+ -- TODO: * remove BSD4
- -- | GNU Public License. Source code must accompany alterations.
+ -- | GNU General Public License,
+ -- or
+ -- .
GPL (Maybe Version)
- -- | GNU Affero General Public License
+ -- | .
| AGPL (Maybe Version)
- -- | Lesser GPL, Less restrictive than GPL, useful for libraries.
+ -- | GNU Lesser General Public License,
+ -- or
+ -- .
| LGPL (Maybe Version)
- -- | 3-clause BSD license, newer, no advertising clause. Very free license.
+ -- | .
+ | BSD2
+
+ -- | .
| BSD3
- -- | 4-clause BSD license, older, with advertising clause. You almost
- -- certainly want to use the BSD3 license instead.
+ -- | .
+ -- This license has not been approved by the OSI and is incompatible with
+ -- the GNU GPL. It is provided for historical reasons and should be avoided.
| BSD4
- -- | The MIT license, similar to the BSD3. Very free license.
+ -- | .
| MIT
- -- | The Apache License. Version 2.0 is the current version,
- -- previous versions are considered historical.
+ -- | .
+ | MPL Version
+ -- | .
| Apache (Maybe Version)
- -- | Holder makes no claim to ownership, least restrictive license.
+ -- | The author of a package disclaims any copyright to its source code and
+ -- dedicates it to the public domain. This is not a software license. Please
+ -- note that it is not possible to dedicate works to the public domain in
+ -- every jurisdiction, nor is a work that is in the public domain in one
+ -- jurisdiction necessarily in the public domain elsewhere.
| PublicDomain
- -- | No rights are granted to others. Undistributable. Most restrictive.
+ -- | No license. The package may not be legally modified or redistributed by
+ -- anyone but the rightsholder.
| AllRightsReserved
- -- | Some other license.
+ -- | Any other software license.
| OtherLicense
- -- | Not a recognised license.
- -- Allows us to deal with future extensions more gracefully.
+ -- | Indicates an erroneous license name.
| UnknownLicense String
deriving (Read, Show, Eq, Typeable, Data)
+-- | 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])
- , BSD3, MIT
+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
+ , MPL (Version [2, 0] [])
, Apache unversioned, Apache (version [2, 0])
, PublicDomain, AllRightsReserved, OtherLicense]
where
@@ -126,9 +126,10 @@
version v = Just (Version v [])
instance Text License where
- disp (GPL version) = Disp.text "GPL" <> dispOptVersion version
- disp (LGPL version) = Disp.text "LGPL" <> dispOptVersion version
- disp (AGPL version) = Disp.text "AGPL" <> dispOptVersion version
+ disp (GPL version) = Disp.text "GPL" <> dispOptVersion version
+ disp (LGPL version) = Disp.text "LGPL" <> dispOptVersion version
+ disp (AGPL version) = Disp.text "AGPL" <> dispOptVersion version
+ disp (MPL version) = Disp.text "MPL" <> dispVersion version
disp (Apache version) = Disp.text "Apache" <> dispOptVersion version
disp (UnknownLicense other) = Disp.text other
disp other = Disp.text (show other)
@@ -140,16 +141,21 @@
("GPL", _ ) -> GPL version
("LGPL", _ ) -> LGPL version
("AGPL", _ ) -> AGPL version
+ ("BSD2", Nothing) -> BSD2
("BSD3", Nothing) -> BSD3
("BSD4", Nothing) -> BSD4
("MIT", Nothing) -> MIT
+ ("MPL", Just version') -> MPL version'
("Apache", _ ) -> Apache version
("PublicDomain", Nothing) -> PublicDomain
("AllRightsReserved", Nothing) -> AllRightsReserved
("OtherLicense", Nothing) -> OtherLicense
- _ -> UnknownLicense $ name
- ++ maybe "" (('-':) . display) version
+ _ -> UnknownLicense $ name ++
+ maybe "" (('-':) . display) version
dispOptVersion :: Maybe Version -> Disp.Doc
dispOptVersion Nothing = Disp.empty
-dispOptVersion (Just v) = Disp.char '-' <> disp v
+dispOptVersion (Just v) = dispVersion v
+
+dispVersion :: Version -> Disp.Doc
+dispVersion v = Disp.char '-' <> disp v
diff --git a/Distribution/Make.hs b/Distribution/Make.hs
--- a/Distribution/Make.hs
+++ b/Distribution/Make.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Make
-- Copyright : Martin Sjögren 2004
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -16,7 +17,7 @@
-- that it works.
--
-- Uses the parsed command-line from "Distribution.Simple.Setup" in order to build
--- Haskell tools using a backend build system based on make. Obviously we
+-- Haskell tools using a back-end build system based on make. Obviously we
-- assume that there is a configure script, and that after the ConfigCmd has
-- been run, there is a Makefile. Further assumptions:
--
@@ -52,36 +53,6 @@
-- copy :
-- $(MAKE) install prefix=$(destdir)/$(prefix) \
-- bindir=$(destdir)/$(bindir) \
-
-{- 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 Isaac Jones 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. -}
module Distribution.Make (
module Distribution.Package,
diff --git a/Distribution/ModuleName.hs b/Distribution/ModuleName.hs
--- a/Distribution/ModuleName.hs
+++ b/Distribution/ModuleName.hs
@@ -3,41 +3,12 @@
-- |
-- Module : Distribution.ModuleName
-- Copyright : Duncan Coutts 2008
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- Data type for Haskell module names.
-
-{- 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 Isaac Jones 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. -}
module Distribution.ModuleName (
ModuleName,
diff --git a/Distribution/Package.hs b/Distribution/Package.hs
--- a/Distribution/Package.hs
+++ b/Distribution/Package.hs
@@ -3,6 +3,7 @@
-- |
-- Module : Distribution.Package
-- Copyright : Isaac Jones 2003-2004
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -11,36 +12,6 @@
-- 'PackageIdentifier's consist of a name and an exact version. It also defines
-- a 'Dependency' data type. A dependency is a package name and a version
-- range, like @\"foo >= 1.2 && < 2\"@.
-
-{- 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 Isaac Jones 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. -}
module Distribution.Package (
-- * Package ids
diff --git a/Distribution/PackageDescription.hs b/Distribution/PackageDescription.hs
--- a/Distribution/PackageDescription.hs
+++ b/Distribution/PackageDescription.hs
@@ -3,6 +3,7 @@
-- |
-- Module : Distribution.PackageDescription
-- Copyright : Isaac Jones 2003-2005
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -21,36 +22,6 @@
-- feature was introduced. It could probably do with being rationalised at some
-- point to make it simpler.
-{- 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 Isaac Jones 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. -}
-
module Distribution.PackageDescription (
-- * Package descriptions
PackageDescription(..),
@@ -163,7 +134,7 @@
-- the following are required by all packages:
package :: PackageIdentifier,
license :: License,
- licenseFile :: FilePath,
+ licenseFiles :: [FilePath],
copyright :: String,
maintainer :: String,
author :: String,
@@ -234,7 +205,7 @@
package = PackageIdentifier (PackageName "")
(Version [] []),
license = AllRightsReserved,
- licenseFile = "",
+ licenseFiles = [],
specVersionRaw = Right anyVersion,
buildType = Nothing,
copyright = "",
@@ -642,7 +613,7 @@
pkgconfigDepends :: [Dependency], -- ^ pkg-config packages that are used
frameworks :: [String], -- ^support frameworks for Mac OS X
cSources :: [FilePath],
- hsSourceDirs :: [FilePath], -- ^ where to look for the haskell module hierarchy
+ hsSourceDirs :: [FilePath], -- ^ where to look for the Haskell module hierarchy
otherModules :: [ModuleName], -- ^ non-exposed or non-main modules
defaultLanguage :: Maybe Language,-- ^ language used when not explicitly specified
@@ -928,7 +899,7 @@
updateExecutable :: (String, BuildInfo) -- ^(exeName, new buildinfo)
-> [Executable] -- ^list of executables to update
- -> [Executable] -- ^libst with exeName updated
+ -> [Executable] -- ^list with exeName updated
updateExecutable _ [] = []
updateExecutable exe_bi'@(name,bi) (exe:exes)
| exeName exe == name = exe{buildInfo = bi `mappend` buildInfo exe} : exes
diff --git a/Distribution/PackageDescription/Check.hs b/Distribution/PackageDescription/Check.hs
--- a/Distribution/PackageDescription/Check.hs
+++ b/Distribution/PackageDescription/Check.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.PackageDescription.Check
-- Copyright : Lennart Kolmodin 2008
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -14,41 +15,11 @@
-- different kinds of check so we can see which ones are appropriate to report
-- in different situations. This code gets uses when configuring a package when
-- we consider only basic problems. The higher standard is uses when when
--- preparing a source tarball and by hackage when uploading new packages. The
+-- preparing a source tarball and by Hackage when uploading new packages. The
-- reason for this is that we want to hold packages that are expected to be
-- distributed to a higher standard than packages that are only ever expected
-- to be used on the author's own environment.
-{- 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 Isaac Jones 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. -}
-
module Distribution.PackageDescription.Check (
-- * Package Checking
PackageCheck(..),
@@ -128,13 +99,13 @@
| PackageBuildWarning { explanation :: String }
-- | An issue that might not be a problem for the package author but
- -- might be annoying or determental when the package is distributed to
+ -- might be annoying or detrimental when the package is distributed to
-- users. We should encourage distributed packages to be free from these
-- issues, but occasionally there are justifiable reasons so we cannot
-- ban them entirely.
| PackageDistSuspicious { explanation :: String }
- -- | An issue that is ok in the author's environment but is almost
+ -- | An issue that is OK in the author's environment but is almost
-- certain to be a portability problem for other environments. We can
-- quite legitimately refuse to publicly distribute packages with these
-- problems.
@@ -160,7 +131,7 @@
-- | Check for common mistakes and problems in package descriptions.
--
--- This is the standard collection of checks covering all apsects except
+-- This is the standard collection of checks covering all aspects except
-- for checks that require looking at files within the package. For those
-- see 'checkPackageFiles'.
--
@@ -244,7 +215,7 @@
catMaybes [
check (not (null moduleDuplicates)) $
- PackageBuildWarning $
+ PackageBuildImpossible $
"Duplicate modules in library: "
++ commaSep (map display moduleDuplicates)
]
@@ -275,7 +246,7 @@
++ "To use this feature you must specify 'cabal-version: >= 1.18'."
, check (not (null moduleDuplicates)) $
- PackageBuildWarning $
+ PackageBuildImpossible $
"Duplicate modules in executable '" ++ exeName exe ++ "': "
++ commaSep (map display moduleDuplicates)
]
@@ -301,7 +272,7 @@
_ -> Nothing
, check (not $ null moduleDuplicates) $
- PackageBuildWarning $
+ PackageBuildImpossible $
"Duplicate modules in test suite '" ++ testName test ++ "': "
++ commaSep (map display moduleDuplicates)
@@ -359,7 +330,7 @@
_ -> Nothing
, check (not $ null moduleDuplicates) $
- PackageBuildWarning $
+ PackageBuildImpossible $
"Duplicate modules in benchmark '" ++ benchmarkName bm ++ "': "
++ commaSep (map display moduleDuplicates)
@@ -458,7 +429,7 @@
, check (null (synopsis pkg) && not (null (description pkg))) $
PackageDistSuspicious "No 'synopsis' field."
- --TODO: recommend the bug reports url, author and homepage fields
+ --TODO: recommend the bug reports URL, author and homepage fields
--TODO: recommend not using the stability field
--TODO: recommend specifying a source repo
@@ -533,7 +504,7 @@
, check (license pkg `notElem` [AllRightsReserved, PublicDomain]
-- AllRightsReserved and PublicDomain are not strictly
-- licenses so don't need license files.
- && null (licenseFile pkg)) $
+ && null (licenseFiles pkg)) $
PackageDistSuspicious "A 'license-file' is not specified."
]
where
@@ -869,7 +840,7 @@
++ [ (path, "extra-lib-dirs") | path <- extraLibDirs bi ]
| bi <- allBuildInfo pkg ]
---TODO: check sets of paths that would be interpreted differently between unix
+--TODO: check sets of paths that would be interpreted differently between Unix
-- and windows, ie case-sensitive or insensitive. Things that might clash, or
-- conversely be distinguished.
@@ -965,7 +936,7 @@
"The package uses wildcard syntax in the 'build-depends' field: "
++ commaSep (map display depsUsingWildcardSyntax)
++ ". To use this new syntax the package need to specify at least "
- ++ "'cabal-version: >= 1.6'. Alternatively, if broader compatability "
+ ++ "'cabal-version: >= 1.6'. Alternatively, if broader compatibility "
++ "is important then use: " ++ commaSep
[ display (Dependency name (eliminateWildcardSyntax versionRange))
| Dependency name versionRange <- depsUsingWildcardSyntax ]
@@ -985,7 +956,7 @@
"The package uses wildcard syntax in the 'tested-with' field: "
++ commaSep (map display testedWithUsingWildcardSyntax)
++ ". To use this new syntax the package need to specify at least "
- ++ "'cabal-version: >= 1.6'. Alternatively, if broader compatability "
+ ++ "'cabal-version: >= 1.6'. Alternatively, if broader compatibility "
++ "is important then use: " ++ commaSep
[ display (Dependency name (eliminateWildcardSyntax versionRange))
| Dependency name versionRange <- testedWithUsingWildcardSyntax ]
@@ -996,7 +967,7 @@
"Using wildcards like "
++ commaSep (map quote $ take 3 dataFilesUsingGlobSyntax)
++ " in the 'data-files' field requires 'cabal-version: >= 1.6'. "
- ++ "Alternatively if you require compatability with earlier Cabal "
+ ++ "Alternatively if you require compatibility with earlier Cabal "
++ "versions then list all the files explicitly."
-- check use of "extra-source-files: mk/*.in" syntax
@@ -1006,7 +977,7 @@
++ commaSep (map quote $ take 3 extraSrcFilesUsingGlobSyntax)
++ " in the 'extra-source-files' field requires "
++ "'cabal-version: >= 1.6'. Alternatively if you require "
- ++ "compatability with earlier Cabal versions then list all the files "
+ ++ "compatibility with earlier Cabal versions then list all the files "
++ "explicitly."
-- check use of "source-repository" section
@@ -1022,7 +993,7 @@
"Unfortunately the license " ++ quote (display (license pkg))
++ " messes up the parser in earlier Cabal versions so you need to "
++ "specify 'cabal-version: >= 1.4'. Alternatively if you require "
- ++ "compatability with earlier Cabal versions then use 'OtherLicense'."
+ ++ "compatibility with earlier Cabal versions then use 'OtherLicense'."
-- check for new language extensions
, checkVersion [1,2,3] (not (null mentionedExtensionsThatNeedCabal12)) $
@@ -1031,7 +1002,7 @@
++ commaSep (map (quote . display) mentionedExtensionsThatNeedCabal12)
++ " break the parser in earlier Cabal versions so you need to "
++ "specify 'cabal-version: >= 1.2.3'. Alternatively if you require "
- ++ "compatability with earlier Cabal versions then you may be able to "
+ ++ "compatibility with earlier Cabal versions then you may be able to "
++ "use an equivalent compiler-specific flag."
, checkVersion [1,4] (not (null mentionedExtensionsThatNeedCabal14)) $
@@ -1040,7 +1011,7 @@
++ commaSep (map (quote . display) mentionedExtensionsThatNeedCabal14)
++ " break the parser in earlier Cabal versions so you need to "
++ "specify 'cabal-version: >= 1.4'. Alternatively if you require "
- ++ "compatability with earlier Cabal versions then you may be able to "
+ ++ "compatibility with earlier Cabal versions then you may be able to "
++ "use an equivalent compiler-specific flag."
]
where
@@ -1168,7 +1139,7 @@
-- | A variation on the normal 'Text' instance, shows any ()'s in the original
-- textual syntax. We need to show these otherwise it's confusing to users when
--- we complain of their presense but do not pretty print them!
+-- we complain of their presence but do not pretty print them!
--
displayRawVersionRange :: VersionRange -> String
displayRawVersionRange =
@@ -1298,7 +1269,7 @@
-- ------------------------------------------------------------
-- | Sanity check things that requires IO. It looks at the files in the
--- package and expects to find the package unpacked in at the given filepath.
+-- package and expects to find the package unpacked in at the given file path.
--
checkPackageFiles :: PackageDescription -> FilePath -> IO [PackageCheck]
checkPackageFiles pkg root = checkPackageContent checkFilesIO pkg
@@ -1328,30 +1299,30 @@
-> PackageDescription
-> m [PackageCheck]
checkPackageContent ops pkg = do
- licenseError <- checkLicenseExists ops pkg
+ licenseErrors <- checkLicensesExist ops pkg
setupError <- checkSetupExists ops pkg
configureError <- checkConfigureExists ops pkg
localPathErrors <- checkLocalPathsExist ops pkg
vcsLocation <- checkMissingVcsInfo ops pkg
- return $ catMaybes [licenseError, setupError, configureError]
+ return $ licenseErrors
+ ++ catMaybes [setupError, configureError]
++ localPathErrors
++ vcsLocation
-checkLicenseExists :: Monad m => CheckPackageContentOps m
+checkLicensesExist :: Monad m => CheckPackageContentOps m
-> PackageDescription
- -> m (Maybe PackageCheck)
-checkLicenseExists ops pkg
- | null (licenseFile pkg) = return Nothing
- | otherwise = do
- exists <- doesFileExist ops file
- return $ check (not exists) $
- PackageBuildWarning $
- "The 'license-file' field refers to the file " ++ quote file
- ++ " which does not exist."
-
+ -> m [PackageCheck]
+checkLicensesExist ops pkg = do
+ exists <- mapM (doesFileExist ops) (licenseFiles pkg)
+ return
+ [ PackageBuildWarning $
+ "The '" ++ fieldname ++ "' field refers to the file "
+ ++ quote file ++ " which does not exist."
+ | (file, False) <- zip (licenseFiles pkg) exists ]
where
- file = licenseFile pkg
+ fieldname | length (licenseFiles pkg) == 1 = "license-file"
+ | otherwise = "license-files"
checkSetupExists :: Monad m => CheckPackageContentOps m
-> PackageDescription
diff --git a/Distribution/PackageDescription/Configuration.hs b/Distribution/PackageDescription/Configuration.hs
--- a/Distribution/PackageDescription/Configuration.hs
+++ b/Distribution/PackageDescription/Configuration.hs
@@ -4,6 +4,7 @@
-- |
-- Module : Distribution.PackageDescription.Configuration
-- Copyright : Thomas Schilling, 2007
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -14,36 +15,6 @@
-- 'PackageDescription's. It has code for working with the tree of conditions
-- and resolving or flattening conditions.
-{- 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 Isaac Jones 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. -}
-
module Distribution.PackageDescription.Configuration (
finalizePackageDescription,
flattenPackageDescription,
@@ -124,7 +95,7 @@
COr c1 c2 -> fv' c1 ++ fv' c2
CAnd c1 c2 -> fv' c1 ++ fv' c2
--- | Simplify a configuration condition using the os and arch names. Returns
+-- | 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
-> (Condition FlagName, [FlagName])
@@ -488,8 +459,9 @@
--
finalizePackageDescription ::
FlagAssignment -- ^ Explicitly specified flag assignments
- -> (Dependency -> Bool) -- ^ Is a given depenency satisfiable from the set of available packages?
- -- If this is unknown then use True.
+ -> (Dependency -> Bool) -- ^ Is a given dependency satisfiable from the set of
+ -- available packages? If this is unknown then use
+ -- True.
-> Platform -- ^ The 'Arch' and 'OS'
-> CompilerId -- ^ Compiler + Version
-> [Dependency] -- ^ Additional constraints
@@ -498,7 +470,8 @@
(PackageDescription, FlagAssignment)
-- ^ Either missing dependencies or the resolved package
-- description along with the flag assignments chosen.
-finalizePackageDescription userflags satisfyDep (Platform arch os) impl constraints
+finalizePackageDescription userflags satisfyDep
+ (Platform arch os) impl constraints
(GenericPackageDescription pkg flags mlib0 exes0 tests0 bms0) =
case resolveFlags of
Right ((mlib, exes', tests', bms'), targetSet, flagVals) ->
@@ -540,9 +513,10 @@
| manual -> [b]
| otherwise -> [b, not b]
--flagDefaults = map (\(n,x:_) -> (n,x)) flagChoices
- check ds = if all satisfyDep ds
- then DepOk
- else MissingDeps $ filter (not . satisfyDep) ds
+ check ds = let missingDeps = filter (not . satisfyDep) ds
+ in if null missingDeps
+ then DepOk
+ else MissingDeps missingDeps
{-
let tst_p = (CondNode [1::Int] [Distribution.Package.Dependency "a" AnyVersion] [])
diff --git a/Distribution/PackageDescription/Parse.hs b/Distribution/PackageDescription/Parse.hs
--- a/Distribution/PackageDescription/Parse.hs
+++ b/Distribution/PackageDescription/Parse.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.PackageDescription.Parse
-- Copyright : Isaac Jones 2003-2005
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -11,36 +12,6 @@
-- backwards compatible with old @.cabal@ files, so there's code to translate
-- into the newer structure.
-{- 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 Isaac Jones 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. -}
-
module Distribution.PackageDescription.Parse (
-- * Package descriptions
readPackageDescription,
@@ -123,16 +94,31 @@
, simpleField "license"
disp parseLicenseQ
license (\l pkg -> pkg{license=l})
+ -- We have both 'license-file' and 'license-files' fields.
+ -- Rather than declaring license-file to be deprecated, we will continue
+ -- to allow both. The 'license-file' will continue to only allow single
+ -- tokens, while 'license-files' allows multiple. On pretty-printing, we
+ -- will use 'license-file' if there's just one, and use 'license-files'
+ -- otherwise.
, simpleField "license-file"
showFilePath parseFilePathQ
- licenseFile (\l pkg -> pkg{licenseFile=l})
+ (\pkg -> case licenseFiles pkg of
+ [x] -> x
+ _ -> "")
+ (\l pkg -> pkg{licenseFiles=licenseFiles pkg ++ [l]})
+ , listField "license-files"
+ showFilePath parseFilePathQ
+ (\pkg -> case licenseFiles pkg of
+ [_] -> []
+ xs -> xs)
+ (\ls pkg -> pkg{licenseFiles=ls})
, simpleField "copyright"
showFreeText parseFreeText
copyright (\val pkg -> pkg{copyright=val})
, simpleField "maintainer"
showFreeText parseFreeText
maintainer (\val pkg -> pkg{maintainer=val})
- , commaListField "build-depends"
+ , commaListFieldWithSep vcat "build-depends"
disp parse
buildDepends (\xs pkg -> pkg{buildDepends=xs})
, simpleField "stability"
@@ -162,19 +148,19 @@
, listField "tested-with"
showTestedWith parseTestedWithQ
testedWith (\val pkg -> pkg{testedWith=val})
- , listField "data-files"
+ , listFieldWithSep vcat "data-files"
showFilePath parseFilePathQ
dataFiles (\val pkg -> pkg{dataFiles=val})
, simpleField "data-dir"
showFilePath parseFilePathQ
dataDir (\val pkg -> pkg{dataDir=val})
- , listField "extra-source-files"
+ , listFieldWithSep vcat "extra-source-files"
showFilePath parseFilePathQ
extraSrcFiles (\val pkg -> pkg{extraSrcFiles=val})
- , listField "extra-tmp-files"
+ , listFieldWithSep vcat "extra-tmp-files"
showFilePath parseFilePathQ
extraTmpFiles (\val pkg -> pkg{extraTmpFiles=val})
- , listField "extra-doc-files"
+ , listFieldWithSep vcat "extra-doc-files"
showFilePath parseFilePathQ
extraDocFiles (\val pkg -> pkg{extraDocFiles=val})
]
@@ -182,8 +168,9 @@
-- | Store any fields beginning with "x-" in the customFields field of
-- a PackageDescription. All other fields will generate a warning.
storeXFieldsPD :: UnrecFieldParser PackageDescription
-storeXFieldsPD (f@('x':'-':_),val) pkg = Just pkg{ customFieldsPD =
- customFieldsPD pkg ++ [(f,val)]}
+storeXFieldsPD (f@('x':'-':_),val) pkg =
+ Just pkg{ customFieldsPD =
+ customFieldsPD pkg ++ [(f,val)]}
storeXFieldsPD _ _ = Nothing
-- ---------------------------------------------------------------------------
@@ -191,7 +178,7 @@
libFieldDescrs :: [FieldDescr Library]
libFieldDescrs =
- [ listField "exposed-modules" disp parseModuleNameQ
+ [ listFieldWithSep vcat "exposed-modules" disp parseModuleNameQ
exposedModules (\mods lib -> lib{exposedModules=mods})
, boolField "exposed"
@@ -201,7 +188,8 @@
storeXFieldsLib :: UnrecFieldParser Library
storeXFieldsLib (f@('x':'-':_), val) l@(Library { libBuildInfo = bi }) =
- Just $ l {libBuildInfo = bi{ customFieldsBI = customFieldsBI bi ++ [(f,val)]}}
+ Just $ l {libBuildInfo =
+ bi{ customFieldsBI = customFieldsBI bi ++ [(f,val)]}}
storeXFieldsLib _ _ = Nothing
-- ---------------------------------------------------------------------------
@@ -412,7 +400,7 @@
, listField "frameworks"
showToken parseTokenQ
frameworks (\val binfo -> binfo{frameworks=val})
- , listField "c-sources"
+ , listFieldWithSep vcat "c-sources"
showFilePath parseFilePathQ
cSources (\paths binfo -> binfo{cSources=paths})
@@ -432,16 +420,16 @@
disp parseExtensionQ
oldExtensions (\exts binfo -> binfo{oldExtensions=exts})
- , listField "extra-libraries"
+ , listFieldWithSep vcat "extra-libraries"
showToken parseTokenQ
extraLibs (\xs binfo -> binfo{extraLibs=xs})
, listField "extra-lib-dirs"
showFilePath parseFilePathQ
extraLibDirs (\xs binfo -> binfo{extraLibDirs=xs})
- , listField "includes"
+ , listFieldWithSep vcat "includes"
showFilePath parseFilePathQ
includes (\paths binfo -> binfo{includes=paths})
- , listField "install-includes"
+ , listFieldWithSep vcat "install-includes"
showFilePath parseFilePathQ
installIncludes (\paths binfo -> binfo{installIncludes=paths})
, listField "include-dirs"
@@ -450,7 +438,7 @@
, listField "hs-source-dirs"
showFilePath parseFilePathQ
hsSourceDirs (\paths binfo -> binfo{hsSourceDirs=paths})
- , listField "other-modules"
+ , listFieldWithSep vcat "other-modules"
disp parseModuleNameQ
otherModules (\val binfo -> binfo{otherModules=val})
, listField "ghc-prof-options"
@@ -773,7 +761,7 @@
-- * an optional library section, and an arbitrary number of executable
-- sections (in any order).
--
- -- The current implementatition just gathers all library-specific fields
+ -- The current implementation just gathers all library-specific fields
-- in a library section and wraps all executable stanzas in an executable
-- section.
sectionizeFields :: [Field] -> [Field]
@@ -990,11 +978,16 @@
lift $ warning $ "Ignoring unknown section type: " ++ sec_type
skipField
getBody
- Just f -> do
+ Just f@(F {}) -> do
_ <- lift $ syntaxError (lineNo f) $
- "Construct not supported at this position: " ++ show f
+ "Plain fields are not allowed in between stanzas: " ++ show f
skipField
getBody
+ Just f@(IfBlock {}) -> do
+ _ <- lift $ syntaxError (lineNo f) $
+ "If-blocks are not allowed in between stanzas: " ++ show f
+ skipField
+ getBody
Nothing -> return ([], [], Nothing, [], [], [])
-- Extracts all fields in a block and returns a 'CondTree'.
@@ -1007,8 +1000,14 @@
let simplFlds = [ F l n v | F l n v <- allflds ]
condFlds = [ f | f@IfBlock{} <- allflds ]
+ sections = [ s | s@Section{} <- allflds ]
let (depFlds, dataFlds) = partition 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
@@ -1035,7 +1034,8 @@
-- Note: we don't parse the "executable" field here, hence the tail hack.
parseExeFields :: [Field] -> PM Executable
- parseExeFields = lift . parseFields (tail executableFieldDescrs) storeXFieldsExe emptyExecutable
+ parseExeFields = lift . parseFields (tail executableFieldDescrs)
+ storeXFieldsExe emptyExecutable
parseTestFields :: LineNo -> [Field] -> PM TestSuite
parseTestFields line fields = do
diff --git a/Distribution/PackageDescription/PrettyPrint.hs b/Distribution/PackageDescription/PrettyPrint.hs
--- a/Distribution/PackageDescription/PrettyPrint.hs
+++ b/Distribution/PackageDescription/PrettyPrint.hs
@@ -2,7 +2,7 @@
--
-- Module : Distribution.PackageDescription.PrettyPrint
-- Copyright : Jürgen Nicklisch-Franken 2010
--- License : AllRightsReserved
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Stability : provisional
@@ -11,36 +11,7 @@
-- | Pretty printing for cabal files
--
-----------------------------------------------------------------------------
-{- 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 Isaac Jones 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. -}
-
module Distribution.PackageDescription.PrettyPrint (
writeGenericPackageDescription,
showGenericPackageDescription,
@@ -56,19 +27,16 @@
Flag(..), PackageDescription(..),
GenericPackageDescription(..))
import Text.PrettyPrint
- (hsep, comma, punctuate, fsep, parens, char, nest, empty,
+ (hsep, comma, punctuate, parens, char, nest, empty,
isEmpty, ($$), (<+>), colon, (<>), text, vcat, ($+$), Doc, render)
import Distribution.Simple.Utils (writeUTF8File)
-import Distribution.ParseUtils (showFreeText, FieldDescr(..))
+import Distribution.ParseUtils (showFreeText, FieldDescr(..), indentWith, ppField, ppFields)
import Distribution.PackageDescription.Parse (pkgDescrFieldDescrs,binfoFieldDescrs,libFieldDescrs,
sourceRepoFieldDescrs)
import Distribution.Package (Dependency(..))
import Distribution.Text (Text(..))
import Data.Maybe (isJust, fromJust, isNothing)
-indentWith :: Int
-indentWith = 4
-
-- | Recompile with false for regression testing
simplifiedPrinting :: Bool
simplifiedPrinting = False
@@ -106,20 +74,12 @@
where
sourceRepoFieldDescrs' = [fd | fd <- sourceRepoFieldDescrs, fieldName fd /= "kind"]
-ppFields :: [FieldDescr a] -> a -> Doc
-ppFields fields x =
- vcat [ ppField name (getter x)
- | FieldDescr name getter _ <- fields]
-
-ppField :: String -> Doc -> Doc
-ppField name fielddoc | isEmpty fielddoc = empty
- | otherwise = text name <> colon <+> fielddoc
-
ppDiffFields :: [FieldDescr a] -> a -> a -> Doc
ppDiffFields fields x y =
- vcat [ ppField name (getter x)
- | FieldDescr name getter _ <- fields,
- render (getter x) /= render (getter y)]
+ vcat [ ppField name (getter x)
+ | FieldDescr name getter _ <- fields
+ , render (getter x) /= render (getter y)
+ ]
ppCustomFields :: [(String,String)] -> Doc
ppCustomFields flds = vcat [ppCustomField f | f <- flds]
@@ -262,7 +222,7 @@
ppDeps :: [Dependency] -> Doc
ppDeps [] = empty
ppDeps deps =
- text "build-depends:" <+> fsep (punctuate comma (map disp deps))
+ text "build-depends:" $+$ nest indentWith (vcat (punctuate comma (map disp deps)))
emptyLine :: Doc -> Doc
emptyLine d = text " " $+$ d
diff --git a/Distribution/ParseUtils.hs b/Distribution/ParseUtils.hs
--- a/Distribution/ParseUtils.hs
+++ b/Distribution/ParseUtils.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.ParseUtils
-- Copyright : (c) The University of Glasgow 2004
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -15,36 +16,6 @@
-- many of the formats we get in various @.cabal@ file fields, like module
-- names, comma separated lists etc.
-{- 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...
{-# OPTIONS_HADDOCK hide #-}
@@ -61,8 +32,9 @@
parseTestedWithQ, parseLicenseQ, parseLanguageQ, parseExtensionQ,
parseSepList, parseCommaList, parseOptCommaList,
showFilePath, showToken, showTestedWith, showFreeText, parseFreeText,
- field, simpleField, listField, spaceListField, commaListField,
- optsField, liftField, boolField, parseQuoted,
+ field, simpleField, listField, listFieldWithSep, spaceListField,
+ commaListField, commaListFieldWithSep, commaNewLineListField,
+ optsField, liftField, boolField, parseQuoted, indentWith,
UnrecFieldParser, warnUnrec, ignoreUnrec,
) where
@@ -87,14 +59,15 @@
import Data.Maybe (fromMaybe)
import Data.Tree as Tree (Tree(..), flatten)
import qualified Data.Map as Map
-import Control.Monad (foldM, ap)
+import Control.Monad (foldM, ap)
import Control.Applicative (Applicative(..))
import System.FilePath (normalise)
import Data.List (sortBy)
-- -----------------------------------------------------------------------------
-type LineNo = Int
+type LineNo = Int
+type Separator = ([Doc] -> Doc)
data PError = AmbiguousParse String LineNo
| NoParse String LineNo
@@ -119,12 +92,12 @@
instance Functor ParseResult where
fmap _ (ParseFailed err) = ParseFailed err
fmap f (ParseOk ws x) = ParseOk ws $ f x
-
+
instance Applicative ParseResult where
pure = return
(<*>) = ap
-
+
instance Monad ParseResult where
return = ParseOk []
ParseFailed err >>= _ = ParseFailed err
@@ -217,37 +190,51 @@
simpleField name showF readF get set
= liftField get set $ field name showF readF
+commaListFieldWithSep :: Separator -> String -> (a -> Doc) -> ReadP [a] a
+ -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
+commaListFieldWithSep separator name showF readF get set =
+ liftField get set' $
+ field name showF' (parseCommaList readF)
+ 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 name showF readF get set =
- liftField get set' $
- field name (fsep . punctuate comma . map showF) (parseCommaList readF)
- where
- set' xs b = set (get b ++ xs) b
+commaListField = commaListFieldWithSep fsep
+commaNewLineListField :: String -> (a -> Doc) -> ReadP [a] a
+ -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
+commaNewLineListField = commaListFieldWithSep sep
+
spaceListField :: String -> (a -> Doc) -> ReadP [a] a
-> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
spaceListField name showF readF get set =
liftField get set' $
- field name (fsep . map showF) (parseSpaceList readF)
+ field name showF' (parseSpaceList readF)
where
set' xs b = set (get b ++ xs) b
+ showF' = fsep . map showF
-listField :: String -> (a -> Doc) -> ReadP [a] a
+listFieldWithSep :: Separator -> String -> (a -> Doc) -> ReadP [a] a
-> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
-listField name showF readF get set =
+listFieldWithSep separator name showF readF get set =
liftField get set' $
- field name (fsep . map showF) (parseOptCommaList readF)
+ field name showF' (parseOptCommaList readF)
where
set' xs b = set (get b ++ xs) b
+ showF' = separator . map showF
+listField :: String -> (a -> Doc) -> ReadP [a] a
+ -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
+listField = listFieldWithSep fsep
+
optsField :: String -> CompilerFlavor -> (b -> [(CompilerFlavor,[String])])
-> ([(CompilerFlavor,[String])] -> b -> b) -> FieldDescr b
optsField name flavor get set =
liftField (fromMaybe [] . lookup flavor . get)
(\opts b -> set (reorder (update flavor opts (get b))) b) $
- field name (hsep . map text)
- (sepBy parseTokenQ' (munch1 isSpace))
+ field name showF (sepBy parseTokenQ' (munch1 isSpace))
where
update _ opts l | all null opts = l --empty opts as if no opts
update f opts [] = [(f,opts)]
@@ -255,6 +242,7 @@
| f == f' = (f, opts' ++ opts) : rest
| otherwise = (f',opts') : update f opts rest
reorder = sortBy (comparing fst)
+ showF = hsep . map text
-- TODO: this is a bit smelly hack. It's because we want to parse bool fields
-- liberally but not accept new parses. We cannot do that with ReadP
@@ -275,11 +263,28 @@
"The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'."
ppFields :: [FieldDescr a] -> a -> Doc
-ppFields fields x = vcat [ ppField name (getter x)
- | FieldDescr name getter _ <- fields]
+ppFields fields x =
+ vcat [ ppField name (getter x) | FieldDescr name getter _ <- fields ]
ppField :: String -> Doc -> Doc
-ppField name fielddoc = text name <> colon <+> fielddoc
+ppField name fielddoc
+ | isEmpty fielddoc = empty
+ | name `elem` nestedFields = text name <> colon $+$ nest indentWith fielddoc
+ | otherwise = text name <> colon <+> fielddoc
+ where
+ nestedFields =
+ [ "description"
+ , "build-depends"
+ , "data-files"
+ , "extra-source-files"
+ , "extra-tmp-files"
+ , "exposed-modules"
+ , "c-sources"
+ , "extra-libraries"
+ , "includes"
+ , "install-includes"
+ , "other-modules"
+ ]
showFields :: [FieldDescr a] -> a -> String
showFields fields = render . ($+$ text "") . ppFields fields
@@ -436,7 +441,7 @@
-- > else
-- > other
--
- -- this is ok
+ -- this is OK
Line LineNo Indent HasTabs String
| Span LineNo String -- ^ span in a line, following brackets
| OpenBracket LineNo | CloseBracket LineNo
@@ -444,7 +449,7 @@
type Indent = Int
type HasTabs = Bool
--- | Tokenise a single line, splitting on '{' '}' and the spans inbetween.
+-- | Tokenise a single line, splitting on '{' '}' and the spans in between.
-- Also trims leading & trailing space on those spans within the line.
tokeniseLine :: (LineNo, Indent, HasTabs, String) -> [Token]
tokeniseLine (n0, i, t, l) = case split n0 l of
@@ -481,8 +486,8 @@
mkTree toks =
layout 0 [] toks >>= \(trees, trailing) -> case trailing of
[] -> return trees
- OpenBracket n:_ -> syntaxError n "mismatched backets, unexpected {"
- CloseBracket n:_ -> syntaxError n "mismatched backets, unexpected }"
+ OpenBracket n:_ -> syntaxError n "mismatched brackets, unexpected {"
+ CloseBracket n:_ -> syntaxError n "mismatched brackets, unexpected }"
-- the following two should never happen:
Span n l :_ -> syntaxError n $ "unexpected span: " ++ show l
Line n _ _ l :_ -> syntaxError n $ "unexpected line: " ++ show l
@@ -711,7 +716,8 @@
-- ** Pretty printing
showFilePath :: FilePath -> Doc
-showFilePath = showToken
+showFilePath "" = empty
+showFilePath x = showToken x
showToken :: String -> Doc
showToken str
@@ -738,3 +744,7 @@
in l : case s' of
[] -> []
(_:s'') -> lines_ s''
+
+-- | the indentation used for pretty printing
+indentWith :: Int
+indentWith = 4
diff --git a/Distribution/ReadE.hs b/Distribution/ReadE.hs
--- a/Distribution/ReadE.hs
+++ b/Distribution/ReadE.hs
@@ -2,42 +2,12 @@
-- |
-- Module : Distribution.ReadE
-- Copyright : Jose Iborra 2008
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- Simple parsing with failure
-
-{- Copyright (c) 2007, Jose Iborra
-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 Isaac Jones 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. -}
module Distribution.ReadE (
-- * ReadE
diff --git a/Distribution/Simple.hs b/Distribution/Simple.hs
--- a/Distribution/Simple.hs
+++ b/Distribution/Simple.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple
-- Copyright : Isaac Jones 2003-2005
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -24,36 +25,6 @@
-- presented the same compatible command line interfaces. There is still a
-- "Distribution.Make" system but in practice no packages use it.
-{- 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 Isaac Jones 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. -}
-
{-
Work around this warning:
libraries/Cabal/Distribution/Simple.hs:78:0:
@@ -85,7 +56,7 @@
-- local
import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Simple.UserHooks
-import Distribution.Package --must not specify imports, since we're exporting moule.
+import Distribution.Package --must not specify imports, since we're exporting module.
import Distribution.PackageDescription
( PackageDescription(..), GenericPackageDescription, Executable(..)
, updatePackageDescription, hasLibs
@@ -134,7 +105,7 @@
import System.Environment(getArgs, getProgName)
import System.Directory(removeFile, doesFileExist,
doesDirectoryExist, removeDirectoryRecursive)
-import System.Exit (exitWith,ExitCode(..))
+import System.Exit
import System.IO.Error (isDoesNotExistError)
import Control.Exception (throwIO)
import Distribution.Compat.Environment (getEnvironment)
@@ -482,7 +453,7 @@
let cFlags' = cFlags {
-- Since the list of unconfigured programs is not serialized,
-- restore it to the same value as normally used at the beginning
- -- of a conigure run:
+ -- of a configure run:
configPrograms = restoreProgramConfiguration
(builtinPrograms ++ hookedPrograms hooks)
(configPrograms cFlags),
diff --git a/Distribution/Simple/Bench.hs b/Distribution/Simple/Bench.hs
--- a/Distribution/Simple/Bench.hs
+++ b/Distribution/Simple/Bench.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.Bench
-- Copyright : Johan Tibell 2011
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -9,36 +10,6 @@
-- This is the entry point into running the benchmarks in a built
-- package. It performs the \"@.\/setup bench@\" action. It runs
-- benchmarks designated in the package description.
-
-{- 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 Isaac Jones 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. -}
module Distribution.Simple.Bench
( bench
diff --git a/Distribution/Simple/Build.hs b/Distribution/Simple/Build.hs
--- a/Distribution/Simple/Build.hs
+++ b/Distribution/Simple/Build.hs
@@ -4,6 +4,7 @@
-- Copyright : Isaac Jones 2003-2005,
-- Ross Paterson 2006,
-- Duncan Coutts 2007-2008, 2012
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -14,39 +15,9 @@
-- running pre-processors.
--
-{- Copyright (c) 2003-2005, Isaac Jones
-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 Isaac Jones 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. -}
-
module Distribution.Simple.Build (
build, repl,
+ startInterpreter,
initialBuildSteps,
writeAutogenFiles,
@@ -58,6 +29,7 @@
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.HaskellSuite as HaskellSuite
import qualified Distribution.Simple.Build.Macros as Build.Macros
import qualified Distribution.Simple.Build.PathsModule as Build.PathsModule
@@ -66,7 +38,8 @@
( Package(..), PackageName(..), PackageIdentifier(..)
, Dependency(..), thisPackageVersion )
import Distribution.Simple.Compiler
- ( CompilerFlavor(..), compilerFlavor, PackageDB(..) )
+ ( Compiler, CompilerFlavor(..), compilerFlavor
+ , PackageDB(..), PackageDBStack )
import Distribution.PackageDescription
( PackageDescription(..), BuildInfo(..), Library(..), Executable(..)
, TestSuite(..), TestSuiteInterface(..), Benchmark(..)
@@ -75,9 +48,8 @@
import qualified Distribution.ModuleName as ModuleName
import Distribution.ModuleName (ModuleName)
-import Distribution.Simple.Program (ghcPkgProgram)
import Distribution.Simple.Setup
- ( BuildFlags(..), ReplFlags(..), fromFlag )
+ ( Flag(..), BuildFlags(..), ReplFlags(..), fromFlag )
import Distribution.Simple.BuildTarget
( BuildTarget(..), readBuildTargets )
import Distribution.Simple.PreProcess
@@ -92,12 +64,11 @@
, 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
( registerPackage, inplaceInstalledPackageInfo )
-import Distribution.Simple.Test ( stubFilePath, stubName )
+import Distribution.Simple.Test.LibV09 ( stubFilePath, stubName )
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, rewriteFile
, die, info, debug, warn, setupMessage )
@@ -118,7 +89,7 @@
import System.FilePath
( (), (<.>) )
import System.Directory
- ( getCurrentDirectory, removeDirectoryRecursive, doesDirectoryExist )
+ ( getCurrentDirectory )
-- -----------------------------------------------------------------------------
-- |Build the libraries and executables in this package.
@@ -143,8 +114,7 @@
-- Only bother with this message if we're building the whole package
setupMessage verbosity "Building" (packageId pkg_descr)
- let Just ghcPkgProg = lookupProgram ghcPkgProgram (withPrograms lbi)
- internalPackageDB <- createInternalPackageDB verbosity ghcPkgProg distPref
+ internalPackageDB <- createInternalPackageDB distPref
withComponentsInBuildOrder pkg_descr lbi componentsToBuild $ \comp clbi ->
let bi = componentBuildInfo comp
@@ -153,7 +123,8 @@
withPrograms = progs',
withPackageDB = withPackageDB lbi ++ [internalPackageDB]
}
- in buildComponent verbosity pkg_descr lbi' suffixes comp clbi distPref
+ in buildComponent verbosity (buildNumJobs flags) pkg_descr
+ lbi' suffixes comp clbi distPref
repl :: PackageDescription -- ^ Mostly information from the .cabal file
@@ -180,8 +151,7 @@
initialBuildSteps distPref pkg_descr lbi verbosity
- let Just ghcPkgProg = lookupProgram ghcPkgProgram (withPrograms lbi)
- internalPackageDB <- createInternalPackageDB verbosity ghcPkgProg distPref
+ internalPackageDB <- createInternalPackageDB distPref
let lbiForComponent comp lbi' =
lbi' {
withPackageDB = withPackageDB lbi ++ [internalPackageDB],
@@ -193,17 +163,26 @@
sequence_
[ let comp = getComponent pkg_descr cname
lbi' = lbiForComponent comp lbi
- in buildComponent verbosity pkg_descr lbi' suffixes comp clbi distPref
+ in buildComponent verbosity NoFlag
+ pkg_descr lbi' suffixes comp clbi distPref
| (cname, clbi) <- init componentsToBuild ]
- -- repl for target components
+ -- REPL for target components
let (cname, clbi) = componentForRepl
comp = getComponent pkg_descr cname
lbi' = lbiForComponent comp lbi
in replComponent verbosity pkg_descr lbi' suffixes comp clbi distPref
+-- | Start an interpreter without loading any package files.
+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."
+
buildComponent :: Verbosity
+ -> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> [PPSuffixHandler]
@@ -211,43 +190,43 @@
-> ComponentLocalBuildInfo
-> FilePath
-> IO ()
-buildComponent verbosity pkg_descr lbi suffixes
+buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CLib lib) clbi distPref = do
preprocessComponent pkg_descr comp lbi False verbosity suffixes
info verbosity "Building library..."
- buildLib verbosity pkg_descr lbi lib clbi
+ buildLib verbosity numJobs pkg_descr lbi lib clbi
-- 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 inplace registration uses the "-inplace" suffix,
+ -- The in place registration uses the "-inplace" suffix,
-- not an ABI hash.
IPI.installedPackageId = inplacePackageId (packageId installedPkgInfo)
}
registerPackage verbosity
- installedPkgInfo pkg_descr lbi True -- True meaning inplace
+ installedPkgInfo pkg_descr lbi True -- True meaning in place
(withPackageDB lbi)
-buildComponent verbosity pkg_descr lbi suffixes
+buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CExe exe) clbi _ = do
preprocessComponent pkg_descr comp lbi False verbosity suffixes
info verbosity $ "Building executable " ++ exeName exe ++ "..."
- buildExe verbosity pkg_descr lbi exe clbi
+ buildExe verbosity numJobs pkg_descr lbi exe clbi
-buildComponent verbosity pkg_descr lbi suffixes
+buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CTest test@TestSuite { testInterface = TestSuiteExeV10{} })
clbi _distPref = do
let exe = testSuiteExeV10AsExe test
preprocessComponent pkg_descr comp lbi False verbosity suffixes
info verbosity $ "Building test suite " ++ testName test ++ "..."
- buildExe verbosity pkg_descr lbi exe clbi
+ buildExe verbosity numJobs pkg_descr lbi exe clbi
-buildComponent verbosity pkg_descr lbi suffixes
+buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CTest
test@TestSuite { testInterface = TestSuiteLibV09{} })
clbi -- This ComponentLocalBuildInfo corresponds to a detailed
@@ -261,27 +240,27 @@
testSuiteLibV09AsLibAndExe pkg_descr lbi test clbi distPref pwd
preprocessComponent pkg_descr comp lbi False verbosity suffixes
info verbosity $ "Building test suite " ++ testName test ++ "..."
- buildLib verbosity pkg lbi lib libClbi
+ buildLib verbosity numJobs pkg lbi lib libClbi
registerPackage verbosity ipi pkg lbi True $ withPackageDB lbi
- buildExe verbosity pkg_descr lbi exe exeClbi
+ buildExe verbosity numJobs pkg_descr lbi exe exeClbi
-buildComponent _ _ _ _
+buildComponent _ _ _ _ _
(CTest TestSuite { testInterface = TestSuiteUnsupported tt })
_ _ =
die $ "No support for building test suite type " ++ display tt
-buildComponent verbosity pkg_descr lbi suffixes
+buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CBench bm@Benchmark { benchmarkInterface = BenchmarkExeV10 {} })
clbi _ = do
let (exe, exeClbi) = benchmarkExeV10asExe bm clbi
preprocessComponent pkg_descr comp lbi False verbosity suffixes
info verbosity $ "Building benchmark " ++ benchmarkName bm ++ "..."
- buildExe verbosity pkg_descr lbi exe exeClbi
+ buildExe verbosity numJobs pkg_descr lbi exe exeClbi
-buildComponent _ _ _ _
+buildComponent _ _ _ _ _
(CBench Benchmark { benchmarkInterface = BenchmarkUnsupported tt })
_ _ =
die $ "No support for building benchmark type " ++ display tt
@@ -439,13 +418,11 @@
-- | Initialize a new package db file for libraries defined
-- internally to the package.
-createInternalPackageDB :: Verbosity -> ConfiguredProgram -> FilePath -> IO PackageDB
-createInternalPackageDB verbosity ghcPkgProg distPref = do
- let dbDir = distPref "package.conf.inplace"
- packageDB = SpecificPackageDB dbDir
- exists <- doesDirectoryExist dbDir
- when exists $ removeDirectoryRecursive dbDir
- HcPkg.init verbosity ghcPkgProg dbDir
+createInternalPackageDB :: FilePath -> IO PackageDB
+createInternalPackageDB distPref = do
+ let dbFile = distPref "package.conf.inplace"
+ packageDB = SpecificPackageDB dbFile
+ writeFile dbFile "[]"
return packageDB
addInternalBuildTools :: PackageDescription -> LocalBuildInfo -> BuildInfo
@@ -465,29 +442,32 @@
-- TODO: build separate libs in separate dirs so that we can build
--- multiple libs, e.g. for 'LibTest' library-style testsuites
-buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo
+-- multiple libs, e.g. for 'LibTest' library-style test suites
+buildLib :: Verbosity -> Flag (Maybe Int)
+ -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
-buildLib verbosity pkg_descr lbi lib clbi =
+buildLib verbosity numJobs pkg_descr lbi lib clbi =
case compilerFlavor (compiler lbi) of
- GHC -> GHC.buildLib verbosity 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
+ 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
+ HaskellSuite {} -> HaskellSuite.buildLib verbosity pkg_descr lbi lib clbi
_ -> die "Building is not supported with this compiler."
-buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo
+buildExe :: Verbosity -> Flag (Maybe Int)
+ -> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
-buildExe verbosity pkg_descr lbi exe clbi =
+buildExe verbosity numJobs pkg_descr lbi exe clbi =
case compilerFlavor (compiler lbi) of
- GHC -> GHC.buildExe verbosity 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
+ 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."
@@ -495,14 +475,16 @@
-> Library -> ComponentLocalBuildInfo -> IO ()
replLib verbosity pkg_descr lbi lib clbi =
case compilerFlavor (compiler lbi) of
- GHC -> GHC.replLib verbosity pkg_descr lbi lib clbi
+ -- '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."
replExe :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
replExe verbosity pkg_descr lbi exe clbi =
case compilerFlavor (compiler lbi) of
- GHC -> GHC.replExe verbosity pkg_descr lbi exe clbi
+ GHC -> GHC.replExe verbosity NoFlag pkg_descr lbi exe clbi
_ -> die "A REPL is not supported for this compiler."
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
@@ -22,6 +22,8 @@
generatePackageVersionMacros,
) where
+import Data.Maybe
+ ( isJust )
import Distribution.Package
( PackageIdentifier(PackageIdentifier) )
import Distribution.Version
@@ -29,7 +31,11 @@
import Distribution.PackageDescription
( PackageDescription )
import Distribution.Simple.LocalBuildInfo
- ( LocalBuildInfo, externalPackageDeps )
+ ( LocalBuildInfo(withPrograms), externalPackageDeps )
+import Distribution.Simple.Program.Db
+ ( configuredPrograms )
+import Distribution.Simple.Program.Types
+ ( ConfiguredProgram(programId, programVersion) )
import Distribution.Text
( display )
@@ -42,8 +48,8 @@
generate :: PackageDescription -> LocalBuildInfo -> String
generate _pkg_descr lbi =
"/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n" ++
- generatePackageVersionMacros (map snd (externalPackageDeps lbi))
-
+ generatePackageVersionMacros (map snd (externalPackageDeps lbi)) ++
+ generateToolVersionMacros (configuredPrograms . withPrograms $ 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
@@ -51,19 +57,42 @@
--
generatePackageVersionMacros :: [PackageIdentifier] -> String
generatePackageVersionMacros pkgids = concat
- [ concat
- ["/* package ",display pkgid," */\n"
- ,"#define VERSION_",pkgname," ",show (display version),"\n"
- ,"#define MIN_VERSION_",pkgname,"(major1,major2,minor) (\\\n"
- ," (major1) < ",major1," || \\\n"
- ," (major1) == ",major1," && (major2) < ",major2," || \\\n"
- ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"
- ,"\n\n"
- ]
+ [ "/* package " ++ display pkgid ++ " */\n"
+ ++ generateMacros "" pkgname version
| pkgid@(PackageIdentifier name version) <- pkgids
- , let (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)
- pkgname = map fixchar (display name)
+ , let pkgname = map fixchar (display name)
]
- where fixchar '-' = '_'
- fixchar c = c
+-- | Helper function that generates just the @TOOL_VERSION_pkg@ and
+-- @MIN_TOOL_VERSION_pkg@ macros for a list of configured programs.
+--
+generateToolVersionMacros :: [ConfiguredProgram] -> String
+generateToolVersionMacros progs = concat
+ [ "/* tool " ++ progid ++ " */\n"
+ ++ generateMacros "TOOL_" progname version
+ | prog <- progs
+ , isJust . programVersion $ prog
+ , let progid = programId prog ++ "-" ++ display version
+ progname = map fixchar (programId prog)
+ Just version = programVersion prog
+ ]
+
+-- | Common implementation of 'generatePackageVersionMacros' and
+-- 'generateToolVersionMacros'.
+--
+generateMacros :: String -> String -> Version -> String
+generateMacros prefix name version =
+ concat
+ ["#define ", prefix, "VERSION_",name," ",show (display version),"\n"
+ ,"#define MIN_", prefix, "VERSION_",name,"(major1,major2,minor) (\\\n"
+ ," (major1) < ",major1," || \\\n"
+ ," (major1) == ",major1," && (major2) < ",major2," || \\\n"
+ ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"
+ ,"\n\n"
+ ]
+ where
+ (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)
+
+fixchar :: Char -> Char
+fixchar '-' = '_'
+fixchar c = c
diff --git a/Distribution/Simple/BuildPaths.hs b/Distribution/Simple/BuildPaths.hs
--- a/Distribution/Simple/BuildPaths.hs
+++ b/Distribution/Simple/BuildPaths.hs
@@ -3,42 +3,13 @@
-- Module : Distribution.Simple.BuildPaths
-- Copyright : Isaac Jones 2003-2004,
-- Duncan Coutts 2008
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- A bunch of dirs, paths and file names used for intermediate build steps.
--
-
-{- 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 Isaac Jones 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. -}
module Distribution.Simple.BuildPaths (
defaultDistPref, srcPref,
diff --git a/Distribution/Simple/CCompiler.hs b/Distribution/Simple/CCompiler.hs
--- a/Distribution/Simple/CCompiler.hs
+++ b/Distribution/Simple/CCompiler.hs
@@ -59,7 +59,7 @@
| ObjectiveC
| CPlusPlus
| ObjectiveCPlusPlus
- deriving (Show)
+ deriving (Eq, Show)
instance Monoid CDialect where
mempty = C
diff --git a/Distribution/Simple/Command.hs b/Distribution/Simple/Command.hs
--- a/Distribution/Simple/Command.hs
+++ b/Distribution/Simple/Command.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.Command
-- Copyright : Duncan Coutts 2007
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -14,36 +15,6 @@
-- command line completion flags. It is designed to allow other tools make
-- derived commands. This feature is used heavily in @cabal-install@.
-{- 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 Isaac Jones 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. -}
-
module Distribution.Simple.Command (
-- * Command interface
@@ -118,11 +89,11 @@
type Name = String
type Description = String
--- | We usually have a datatype for storing configuration values, where
+-- | We usually have a data type for storing configuration values, where
-- every field stores a configuration option, and the user sets
-- the value either via command line flags or a configuration file.
-- An individual OptionField models such a field, and we usually
--- build a list of options associated to a configuration datatype.
+-- build a list of options associated to a configuration data type.
data OptionField a = OptionField {
optionName :: Name,
optionDescr :: [OptDescr a] }
@@ -251,7 +222,11 @@
set' (Just txt) = readEOrFail set txt
optDescrToGetOpt (ChoiceOpt alts) =
[GetOpt.Option sf lf (GetOpt.NoArg set) d | (d,(sf,lf),set,_) <- alts ]
- optDescrToGetOpt (BoolOpt d (sfT,lfT) (sfF, lfF) set _) =
+ optDescrToGetOpt (BoolOpt d (sfT, lfT) ([], []) set _) =
+ [ GetOpt.Option sfT lfT (GetOpt.NoArg (set True)) d ]
+ optDescrToGetOpt (BoolOpt d ([], []) (sfF, lfF) set _) =
+ [ GetOpt.Option sfF lfF (GetOpt.NoArg (set False)) d ]
+ optDescrToGetOpt (BoolOpt d (sfT,lfT) (sfF, lfF) set _) =
[ GetOpt.Option sfT lfT (GetOpt.NoArg (set True)) ("Enable " ++ d)
, GetOpt.Option sfF lfF (GetOpt.NoArg (set False)) ("Disable " ++ d) ]
@@ -358,12 +333,15 @@
[ showOptDescr v od | o <- commandOptions command ParseArgs
, od <- optionDescr o]
where
+ maybePrefix [] = []
+ maybePrefix (lOpt:_) = ["--" ++ lOpt]
+
showOptDescr :: a -> OptDescr a -> [String]
- showOptDescr x (BoolOpt _ (_,lfT:_) (_,lfF:_) _ enabled)
+ showOptDescr x (BoolOpt _ (_,lfTs) (_,lfFs) _ enabled)
= case enabled x of
Nothing -> []
- Just True -> ["--" ++ lfT]
- Just False -> ["--" ++ lfF]
+ Just True -> maybePrefix lfTs
+ Just False -> maybePrefix lfFs
showOptDescr x c@ChoiceOpt{}
= ["--" ++ val | val <- getCurrentChoice c x]
showOptDescr x (ReqArg _ (_ssff,lf:_) _ _ showflag)
@@ -472,9 +450,11 @@
where -- Note: It is crucial to use reverse function composition here or to
-- reverse the flags here as we want to process the flags left to right
- -- but data flow in function compsition is right to left.
+ -- but data flow in function composition is right to left.
accum flags = foldr (flip (.)) id [ f | Right f <- flags ]
- unrecognised opts = [ "unrecognized option `" ++ opt ++ "'\n"
+ unrecognised opts = [ "unrecognized "
+ ++ "'" ++ (commandName command) ++ "'"
+ ++ " option `" ++ opt ++ "'\n"
| opt <- opts ]
-- For unrecognised global flags we put them in the position just after
-- the command, if there is one. This gives us a chance to parse them
diff --git a/Distribution/Simple/Compiler.hs b/Distribution/Simple/Compiler.hs
--- a/Distribution/Simple/Compiler.hs
+++ b/Distribution/Simple/Compiler.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.Compiler
-- Copyright : Isaac Jones 2003-2004
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -17,36 +18,6 @@
-- per-user one and it lets you create arbitrary other package databases. We do
-- not yet fully support this latter feature.
-{- 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 Isaac Jones 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. -}
-
module Distribution.Simple.Compiler (
-- * Haskell implementations
module Distribution.Compiler,
@@ -69,7 +40,8 @@
languageToFlags,
unsupportedLanguages,
extensionsToFlags,
- unsupportedExtensions
+ unsupportedExtensions,
+ parmakeSupported
) where
import Distribution.Compiler
@@ -79,13 +51,19 @@
import Control.Monad (liftM)
import Data.List (nub)
+import qualified Data.Map as M (Map, lookup)
import Data.Maybe (catMaybes, isNothing)
import System.Directory (canonicalizePath)
data Compiler = Compiler {
compilerId :: CompilerId,
+ -- ^ Compiler flavour and version.
compilerLanguages :: [(Language, Flag)],
- compilerExtensions :: [(Extension, Flag)]
+ -- ^ Supported language standards.
+ compilerExtensions :: [(Extension, Flag)],
+ -- ^ Supported extensions.
+ compilerProperties :: M.Map String String
+ -- ^ A key-value map for properties not covered by the above fields.
}
deriving (Show, Read)
@@ -208,3 +186,12 @@
extensionToFlag :: Compiler -> Extension -> Maybe Flag
extensionToFlag comp ext = lookup ext (compilerExtensions comp)
+
+-- | Does this compiler support parallel --make mode?
+parmakeSupported :: Compiler -> Bool
+parmakeSupported comp =
+ case compilerFlavor comp of
+ GHC -> case M.lookup "Support parallel --make" (compilerProperties comp) of
+ Just "YES" -> True
+ _ -> False
+ _ -> False
diff --git a/Distribution/Simple/Configure.hs b/Distribution/Simple/Configure.hs
--- a/Distribution/Simple/Configure.hs
+++ b/Distribution/Simple/Configure.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.Configure
-- Copyright : Isaac Jones 2003-2005
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -20,36 +21,6 @@
-- the user, the amount of information displayed depending on the verbosity
-- level.
-{- 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 Isaac Jones 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. -}
-
module Distribution.Simple.Configure (configure,
writePersistBuildConfig,
getPersistBuildConfig,
@@ -82,7 +53,7 @@
( PackageName(PackageName), PackageIdentifier(..), PackageId
, packageName, packageVersion, Package(..)
, Dependency(Dependency), simplifyDependency
- , InstalledPackageId(..) )
+ , InstalledPackageId(..), thisPackageVersion )
import Distribution.InstalledPackageInfo as Installed
( InstalledPackageInfo, InstalledPackageInfo_(..)
, emptyInstalledPackageInfo )
@@ -92,7 +63,7 @@
( PackageDescription(..), specVersion, GenericPackageDescription(..)
, Library(..), hasLibs, Executable(..), BuildInfo(..), allExtensions
, HookedBuildInfo, updatePackageDescription, allBuildInfo
- , FlagName(..), TestSuite(..), Benchmark(..) )
+ , Flag(flagName), FlagName(..), TestSuite(..), Benchmark(..) )
import Distribution.PackageDescription.Configuration
( finalizePackageDescription, mapTreeData )
import Distribution.PackageDescription.Check
@@ -130,10 +101,6 @@
( Version(..), anyVersion, orLaterVersion, withinRange, isAnyVersion )
import Distribution.Verbosity
( Verbosity, lessVerbose )
-import Distribution.Simple.Program.Db
- ( lookupProgram )
-import Distribution.Simple.Program.Builtin
- ( ghcProgram )
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.JHC as JHC
@@ -141,15 +108,18 @@
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.HaskellSuite as HaskellSuite
import Control.Monad
( when, unless, foldM, filterM )
import Data.List
- ( nub, partition, isPrefixOf, inits )
+ ( (\\), nub, partition, isPrefixOf, inits )
import Data.Maybe
( isNothing, catMaybes, fromMaybe )
import Data.Monoid
( Monoid(..) )
+import qualified Data.Map as Map
+import Data.Map (Map)
import System.Directory
( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory )
import System.FilePath
@@ -161,7 +131,8 @@
import Distribution.Text
( Text(disp), display, simpleParse )
import Text.PrettyPrint
- ( comma, punctuate, render, nest, sep )
+ ( render, (<>), ($+$), char, text, comma
+ , quotes, punctuate, nest, sep, hsep )
import Distribution.Compat.Exception ( catchExit, catchIO )
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
@@ -248,7 +219,6 @@
"Saved package config for " ++ display pkgid
++ " written by " ++ display currentCabalId
++ " using " ++ display currentCompilerId
- where
currentCabalId :: PackageIdentifier
currentCabalId = PackageIdentifier (PackageName "Cabal") cabalVersion
@@ -339,11 +309,34 @@
installedPackageSet <- getInstalledPackages (lessVerbose verbosity) comp
packageDbs programsConfig'
- let -- Constraint test function for the solver
- dependencySatisfiable =
- not . null . PackageIndex.lookupDependency pkgs'
+ (allConstraints, requiredDepsMap) <- either die return $
+ combinedConstraints (configConstraints cfg)
+ (configDependencies cfg)
+ installedPackageSet
+
+ let exactConf = fromFlagOrDefault False (configExactConfiguration cfg)
+ -- Constraint test function for the solver
+ dependencySatisfiable d@(Dependency depName verRange)
+ | exactConf =
+ -- When we're given '--exact-configuration', we assume that all
+ -- dependencies and flags are exactly specified on the command
+ -- line. Thus we only consult the 'requiredDepsMap'. Note that
+ -- we're not doing the version range check, so if there's some
+ -- dependency that wasn't specified on the command line,
+ -- 'finalizePackageDescription' will fail.
+ --
+ -- TODO: mention '--exact-configuration' in the error message
+ -- when this fails?
+ (depName `Map.member` requiredDepsMap) || isInternalDep
+
+ | otherwise =
+ -- Normal operation: just look up dependency in the package
+ -- index.
+ not . null . PackageIndex.lookupDependency pkgs' $ d
where
pkgs' = PackageIndex.insert internalPackage installedPackageSet
+ isInternalDep = pkgName pid == depName
+ && pkgVersion pid `withinRange` verRange
enableTest t = t { testEnabled = fromFlag (configTests cfg) }
flaggedTests = map (\(n, t) -> (n, mapTreeData enableTest t))
(condTestSuites pkg_descr0)
@@ -361,7 +354,7 @@
dependencySatisfiable
compPlatform
(compilerId comp)
- (configConstraints cfg)
+ allConstraints
pkg_descr0''
of Right r -> return r
Left missing ->
@@ -370,6 +363,17 @@
. map (disp . simplifyDependency)
$ missing)
+ -- Sanity check: if '--exact-configuration' was given, ensure that the
+ -- complete flag assignment was specified on the command line.
+ when exactConf $ do
+ let cmdlineFlags = map fst (configConfigurationsFlags cfg)
+ allFlags = map flagName . genPackageFlags $ pkg_descr0
+ diffFlags = allFlags \\ cmdlineFlags
+ when (not . null $ diffFlags) $
+ die $ "'--exact-conf' was given, "
+ ++ "but the following flags were not specified: "
+ ++ intercalate ", " (map show diffFlags)
+
-- add extra include/lib dirs as specified in cfg
-- we do it here so that those get checked too
let pkg_descr =
@@ -384,9 +388,12 @@
checkPackageProblems verbosity pkg_descr0
(updatePackageDescription pbi pkg_descr)
- let selectDependencies =
+ let selectDependencies :: [Dependency] ->
+ ([FailedDependency], [ResolvedDependency])
+ selectDependencies =
(\xs -> ([ x | Left x <- xs ], [ x | Right x <- xs ]))
- . map (selectDependency internalPackageSet installedPackageSet)
+ . map (selectDependency internalPackageSet installedPackageSet
+ requiredDepsMap)
(failedDeps, allPkgDeps) =
selectDependencies (buildDepends pkg_descr)
@@ -502,17 +509,13 @@
"--enable-split-objs; ignoring")
return False
-
- sharedLibsByDefault <-
- case compilerId comp of
- CompilerId GHC _ ->
- case lookupProgram ghcProgram programsConfig''' of
- Just ghcProg ->
- -- if ghc is dynamic, then ghci needs a shared
- -- library, so we build one by default.
- GHC.ghcDynamic verbosity ghcProg
- Nothing -> return False
- _ -> return False
+ let sharedLibsByDefault =
+ 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
+ _ -> False
let lbi = LocalBuildInfo {
configFlags = cfg,
@@ -541,6 +544,7 @@
withGHCiLib = fromFlag $ configGHCiLib cfg,
splitObjs = split_objs,
stripExes = fromFlag $ configStripExes cfg,
+ stripLibs = fromFlag $ configStripLibs cfg,
withPackageDB = packageDbs,
progPrefix = fromFlag $ configProgPrefix cfg,
progSuffix = fromFlag $ configProgSuffix cfg
@@ -627,9 +631,11 @@
-- | Test for a package dependency and record the version we have installed.
selectDependency :: PackageIndex -- ^ Internally defined packages
-> PackageIndex -- ^ Installed packages
+ -> Map PackageName InstalledPackageInfo
+ -- ^ Packages for which we have been given specific deps to use
-> Dependency
-> Either FailedDependency ResolvedDependency
-selectDependency internalIndex installedIndex
+selectDependency internalIndex installedIndex requiredDepsMap
dep@(Dependency pkgname vr) =
-- If the dependency specification matches anything in the internal package
-- index, then we prefer that match to anything in the second.
@@ -649,12 +655,15 @@
[(_,[pkg])] | packageVersion pkg `withinRange` vr
-> Right $ InternalDependency dep (packageId pkg)
- _ -> case PackageIndex.lookupDependency installedIndex dep of
- [] -> Left $ DependencyNotExists pkgname
- pkgs -> Right $ ExternalDependency dep $
- -- by default we just pick the latest
+ _ -> case Map.lookup pkgname requiredDepsMap of
+ -- If we know the exact pkg to use, then use it.
+ Just pkginstance -> Right (ExternalDependency dep pkginstance)
+ -- Otherwise we just pick an arbitrary instance of the latest version.
+ Nothing -> case PackageIndex.lookupDependency installedIndex dep of
+ [] -> Left $ DependencyNotExists pkgname
+ pkgs -> Right $ ExternalDependency dep $
case last pkgs of
- (_ver, instances) -> head instances -- the first preference
+ (_ver, pkginstances) -> head pkginstances
reportSelectedDependencies :: Verbosity
-> [ResolvedDependency] -> IO ()
@@ -698,6 +707,8 @@
LHC -> LHC.getInstalledPackages verbosity packageDBs progconf
NHC -> NHC.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 "
++ display flv
@@ -743,6 +754,79 @@
newPackageDepsBehaviour pkg =
specVersion pkg >= newPackageDepsBehaviourMinVersion
+-- We are given both --constraint="foo < 2.0" style constraints and also
+-- specific packages to pick via --dependency="foo=foo-2.0-177d5cdf20962d0581".
+--
+-- When finalising the package we have to take into account the specific
+-- installed deps we've been given, and the finalise function expects
+-- constraints, so we have to translate these deps into version constraints.
+--
+-- But after finalising we then have to make sure we pick the right specific
+-- deps in the end. So we still need to remember which installed packages to
+-- pick.
+combinedConstraints :: [Dependency] ->
+ [(PackageName, InstalledPackageId)] ->
+ PackageIndex ->
+ Either String ([Dependency],
+ Map PackageName InstalledPackageInfo)
+combinedConstraints constraints dependencies installedPackages = do
+
+ when (not (null badInstalledPackageIds)) $
+ Left $ render $ text "The following package dependencies were requested"
+ $+$ nest 4 (dispDependencies badInstalledPackageIds)
+ $+$ text "however the given installed package instance does not exist."
+
+ when (not (null badNames)) $
+ Left $ render $ text "The following package dependencies were requested"
+ $+$ nest 4 (dispDependencies badNames)
+ $+$ text "however the installed package's name does not match the name given."
+
+ --TODO: we don't check that all dependencies are used!
+
+ return (allConstraints, idConstraintMap)
+
+ where
+ allConstraints :: [Dependency]
+ allConstraints = constraints
+ ++ [ thisPackageVersion (packageId pkg)
+ | (_, _, Just pkg) <- dependenciesPkgInfo ]
+
+ idConstraintMap :: Map PackageName InstalledPackageInfo
+ idConstraintMap = Map.fromList
+ [ (packageName pkg, pkg)
+ | (_, _, Just pkg) <- dependenciesPkgInfo ]
+
+ -- The dependencies along with the installed package info, if it exists
+ dependenciesPkgInfo :: [(PackageName, InstalledPackageId,
+ Maybe InstalledPackageInfo)]
+ dependenciesPkgInfo =
+ [ (pkgname, ipkgid, mpkg)
+ | (pkgname, ipkgid) <- dependencies
+ , let mpkg = PackageIndex.lookupInstalledPackageId
+ installedPackages ipkgid
+ ]
+
+ -- If we looked up a package specified by an installed package id
+ -- (i.e. someone has written a hash) and didn't find it then it's
+ -- an error.
+ badInstalledPackageIds =
+ [ (pkgname, ipkgid)
+ | (pkgname, ipkgid, Nothing) <- dependenciesPkgInfo ]
+
+ -- If someone has written e.g.
+ -- --dependency="foo=MyOtherLib-1.0-07...5bf30" then they have
+ -- probably made a mistake.
+ badNames =
+ [ (requestedPkgName, ipkgid)
+ | (requestedPkgName, ipkgid, Just pkg) <- dependenciesPkgInfo
+ , let foundPkgName = packageName pkg
+ , requestedPkgName /= foundPkgName ]
+
+ dispDependencies deps =
+ hsep [ text "--dependency="
+ <> quotes (disp pkgname <> char '=' <> disp ipkgid)
+ | (pkgname, ipkgid) <- deps ]
+
-- -----------------------------------------------------------------------------
-- Configuring program dependencies
@@ -800,9 +884,11 @@
Just v | not (withinRange v range) -> die (badVersion v)
| otherwise -> info verbosity (depSatisfied v)
where
- notFound = "The pkg-config package " ++ pkg ++ versionRequirement
+ notFound = "The pkg-config package '" ++ pkg ++ "'"
+ ++ versionRequirement
++ " is required but it could not be found."
- badVersion v = "The pkg-config package " ++ pkg ++ versionRequirement
+ badVersion v = "The pkg-config package '" ++ pkg ++ "'"
+ ++ versionRequirement
++ " is required but the version installed on the"
++ " system is version " ++ display v
depSatisfied v = "Dependency " ++ display dep
@@ -878,6 +964,7 @@
Hugs -> Hugs.configure verbosity hcPath hcPkg conf
NHC -> NHC.configure verbosity hcPath hcPkg conf
UHC -> UHC.configure verbosity hcPath hcPkg conf
+ HaskellSuite {} -> HaskellSuite.configure verbosity hcPath hcPkg conf
_ -> die "Unknown compiler"
return (comp, fromMaybe buildPlatform maybePlatform, programsConfig)
@@ -1072,6 +1159,7 @@
_ <- 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)
diff --git a/Distribution/Simple/GHC.hs b/Distribution/Simple/GHC.hs
--- a/Distribution/Simple/GHC.hs
+++ b/Distribution/Simple/GHC.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.GHC
-- Copyright : Isaac Jones 2003-2007
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -29,42 +30,12 @@
-- explicitly documented) and thus what search dirs are used for various kinds
-- of files.
-{- Copyright (c) 2003-2005, Isaac Jones
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modiication, 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 Isaac Jones 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. -}
-
module Distribution.Simple.GHC (
getGhcInfo,
configure, getInstalledPackages, getPackageDBContents,
buildLib, buildExe,
replLib, replExe,
+ startInterpreter,
installLib, installExe,
libAbiHash,
initPackageDB,
@@ -73,6 +44,7 @@
componentGhcOptions,
ghcLibDir,
ghcDynamic,
+ ghcGlobalPackageDB,
) where
import qualified Distribution.Simple.GHC.IPI641 as IPI641
@@ -105,13 +77,17 @@
, requireProgramVersion, requireProgram
, userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
, ghcProgram, ghcPkgProgram, hsc2hsProgram
- , arProgram, ranlibProgram, ldProgram
+ , 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)
+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
@@ -129,11 +105,11 @@
import Control.Monad ( unless, when )
import Data.Char ( isSpace )
import Data.List
-import Data.Maybe ( catMaybes, fromMaybe )
+import qualified Data.Map as M ( Map, fromList, lookup )
+import Data.Maybe ( catMaybes, fromMaybe, maybeToList )
import Data.Monoid ( Monoid(..) )
import System.Directory
- ( removeFile, getDirectoryContents, doesFileExist
- , getTemporaryDirectory )
+ ( getDirectoryContents, doesFileExist, getTemporaryDirectory )
import System.FilePath ( (), (<.>), takeExtension,
takeDirectory, replaceExtension,
splitExtension )
@@ -179,14 +155,16 @@
extensions <- getExtensions verbosity ghcProg
ghcInfo <- getGhcInfo verbosity ghcProg
+ let ghcInfoMap = M.fromList ghcInfo
let comp = Compiler {
- compilerId = CompilerId GHC ghcVersion,
- compilerLanguages = languages,
- compilerExtensions = extensions
+ compilerId = CompilerId GHC ghcVersion,
+ compilerLanguages = languages,
+ compilerExtensions = extensions,
+ compilerProperties = ghcInfoMap
}
compPlatform = targetPlatform ghcInfo
- conf4 = configureToolchain ghcProg ghcInfo conf3 -- configure gcc and ld
+ conf4 = configureToolchain ghcProg ghcInfoMap conf3 -- configure gcc and ld
return (comp, compPlatform, conf4)
targetPlatform :: [(String, String)] -> Maybe Platform
@@ -263,7 +241,7 @@
-- | Adjust the way we find and configure gcc and ld
--
-configureToolchain :: ConfiguredProgram -> [(String, String)]
+configureToolchain :: ConfiguredProgram -> M.Map String String
-> ProgramConfiguration
-> ProgramConfiguration
configureToolchain ghcProg ghcInfo =
@@ -291,34 +269,50 @@
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
- extraGccPath
- | ghcVersion >= Version [6,12] [] = mingwBinDir binPrefix ++ "gcc.exe"
- | otherwise = baseDir "gcc.exe"
- extraLdPath
- | ghcVersion >= Version [6,12] [] = mingwBinDir binPrefix ++ "ld.exe"
- | otherwise = libDir "ld.exe"
- extraArPath
- | ghcVersion >= Version [6,12] [] = mingwBinDir binPrefix ++ "ar.exe"
- | otherwise = libDir "ar.exe"
- extraStripPath
- | ghcVersion >= Version [6,12] [] = mingwBinDir binPrefix ++
- "strip.exe"
- | otherwise = libDir "strip.exe"
+ 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
+ findProg :: Program -> [FilePath]
-> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
findProg prog extraPath v searchpath =
programFindLocation prog v searchpath'
where
- searchpath' | isWindows = ProgramSearchPathDir extraPath : searchpath
- | otherwise = searchpath
+ 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 lookup key ghcInfo of
+ getFlags key = case M.lookup key ghcInfo of
Nothing -> []
Just flags ->
case reads flags of
@@ -426,7 +420,7 @@
then -- ghc-6.8 introduced RecordPuns however it
-- should have been NamedFieldPuns. We now
-- encourage packages to use NamedFieldPuns
- -- so for compatability we fake support for
+ -- 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") :
@@ -524,7 +518,7 @@
[(_,[rts])]
-> PackageIndex.insert (removeMingwIncludeDir rts) index
_ -> index -- No (or multiple) ghc rts package is registered!!
- -- Feh, whatever, the ghc testsuite does some crazy stuff.
+ -- 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
@@ -556,10 +550,17 @@
(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.
+-- package DBs and chaos is likely to ensue.
checkPackageDbEnvVar :: IO ()
checkPackageDbEnvVar = do
hasGPP <- (getEnv "GHC_PACKAGE_PATH" >> return True)
@@ -661,22 +662,23 @@
-- | Build a library with GHC.
--
-buildLib, replLib :: Verbosity
+buildLib, replLib :: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib = buildOrReplLib False
replLib = buildOrReplLib True
-buildOrReplLib :: Bool -> Verbosity
+buildOrReplLib :: Bool -> Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
-buildOrReplLib forRepl verbosity pkg_descr lbi lib clbi = do
+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))
@@ -690,14 +692,14 @@
(Platform _hostArch hostOS) = hostPlatform lbi
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
- let runGhcProg = runGHC verbosity ghcProg
+ let runGhcProg = runGHC verbosity ghcProg comp
libBi <- hackThreadedFlag verbosity
comp (withProfLib lbi) (libBuildInfo lib)
- isGhcDynamic <- ghcDynamic verbosity ghcProg
- dynamicTooSupported <- ghcSupportsDynamicToo verbosity ghcProg
- let doingTH = EnableExtension TemplateHaskell `elem` allExtensions libBi
+ 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
@@ -709,6 +711,7 @@
baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
vanillaOpts = baseOpts `mappend` mempty {
ghcOptMode = toFlag GhcModeMake,
+ ghcOptNumJobs = toFlag numJobs,
ghcOptPackageName = toFlag pkgid,
ghcOptInputModules = libModules lib
}
@@ -736,7 +739,8 @@
}
replOpts = vanillaOpts {
ghcOptExtra = filterGhciFlags
- (ghcOptExtra vanillaOpts)
+ (ghcOptExtra vanillaOpts),
+ ghcOptNumJobs = mempty
}
`mappend` linkerOpts
`mappend` mempty {
@@ -767,13 +771,8 @@
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
+ [ do let vanillaCcOpts = (componentCcGhcOptions verbosity lbi
+ libBi clbi libTargetDir filename)
profCcOpts = vanillaCcOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptObjSuffix = toFlag "p_o"
@@ -841,11 +840,6 @@
else return []
unless (null hObjs && null cObjs && null stubObjs) $ do
- -- first remove library files if they exists
- unless forRepl $ sequence_
- [ removeFile libFilePath `catchIO` \_ -> return ()
- | libFilePath <- [vanillaLibFilePath, profileLibFilePath
- ,sharedLibFilePath, ghciLibFilePath] ]
let staticObjectFiles =
hObjs
@@ -888,14 +882,10 @@
}
whenVanillaLib False $ do
- (arProg, _) <- requireProgram verbosity arProgram (withPrograms lbi)
- Ar.createArLibArchive verbosity arProg
- vanillaLibFilePath staticObjectFiles
+ Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles
whenProfLib $ do
- (arProg, _) <- requireProgram verbosity arProgram (withPrograms lbi)
- Ar.createArLibArchive verbosity arProg
- profileLibFilePath profObjectFiles
+ Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles
whenGHCiLib $ do
(ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
@@ -905,26 +895,40 @@
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
+buildExe, replExe :: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildExe = buildOrReplExe False
replExe = buildOrReplExe True
-buildOrReplExe :: Bool -> Verbosity
+buildOrReplExe :: Bool -> Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
-buildOrReplExe forRepl verbosity _pkg_descr lbi
+buildOrReplExe forRepl verbosity numJobsFlag _pkg_descr lbi
exe@Executable { exeName = exeName', modulePath = modPath } clbi = do
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
- let runGhcProg = runGHC verbosity ghcProg
+ let comp = compiler lbi
+ numJobs = fromMaybe 1 $
+ fromFlagOrDefault Nothing numJobsFlag
+ runGhcProg = runGHC verbosity ghcProg comp
exeBi <- hackThreadedFlag verbosity
- (compiler lbi) (withProfExe lbi) (buildInfo exe)
+ comp (withProfExe lbi) (buildInfo exe)
-- exeNameReal, the name that GHC really uses (with .exe on Windows)
let exeNameReal = exeName' <.>
@@ -942,10 +946,9 @@
-- build executables
srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath
- isGhcDynamic <- ghcDynamic verbosity ghcProg
- dynamicTooSupported <- ghcSupportsDynamicToo verbosity ghcProg
-
- let isHaskellMain = elem (takeExtension srcMainFile) [".hs", ".lhs"]
+ 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)
@@ -1012,7 +1015,7 @@
-- 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 compilng twice?
+ -- Should we use -dynamic-too instead of compiling twice?
useDynToo = dynamicTooSupported && isGhcDynamic
&& doingTH && withStaticExe && null (ghcSharedOptions exeBi)
compileTHOpts | isGhcDynamic = dynOpts
@@ -1030,10 +1033,12 @@
-- Build static/dynamic object files for TH, if needed.
when compileForTH $
- runGhcProg compileTHOpts { ghcOptNoLink = toFlag True }
+ runGhcProg compileTHOpts { ghcOptNoLink = toFlag True
+ , ghcOptNumJobs = toFlag numJobs }
unless forRepl $
- runGhcProg compileOpts { ghcOptNoLink = toFlag True }
+ runGhcProg compileOpts { ghcOptNoLink = toFlag True
+ , ghcOptNumJobs = toFlag numJobs }
-- build any C sources
unless (null cSrcs) $ do
@@ -1122,6 +1127,7 @@
libBi <- hackThreadedFlag verbosity
(compiler lbi) (withProfLib lbi) (libBuildInfo lib)
let
+ comp = compiler lbi
vanillaArgs =
(componentGhcOptions verbosity lbi libBi clbi (buildDir lbi))
`mappend` mempty {
@@ -1148,7 +1154,7 @@
else error "libAbiHash: Can't find an enabled library way"
--
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
- getProgramInvocationOutput verbosity (ghcInvocation ghcProg ghcArgs)
+ getProgramInvocationOutput verbosity (ghcInvocation ghcProg comp ghcArgs)
componentGhcOptions :: Verbosity -> LocalBuildInfo
@@ -1237,31 +1243,16 @@
installExecutableFile verbosity
(buildPref exeName exe exeFileName)
(dest <.> exeExtension)
- stripExe verbosity lbi exeFileName (dest <.> exeExtension)
+ when (stripExes lbi) $
+ Strip.stripExe verbosity (hostPlatform lbi) (withPrograms lbi)
+ (dest <.> exeExtension)
installBinary (binDir fixedExeBaseName)
-stripExe :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> IO ()
-stripExe verbosity lbi name path = when (stripExes lbi) $
- case lookupProgram stripProgram (withPrograms lbi) of
- Just strip -> rawSystemProgram verbosity strip args
- Nothing -> unless (buildOS == Windows) $
- -- Don't bother warning on windows, we don't expect them to
- -- have the strip program anyway.
- warn verbosity $ "Unable to strip executable '" ++ name
- ++ "' (missing the 'strip' program)"
- where
- args = path : case buildOS of
- OSX -> ["-x"] -- By default, stripping the ghc binary on at least
- -- some OS X installations causes:
- -- HSbase-3.0.o: unknown symbol `_environ'"
- -- The -x flag fixes that.
- _ -> []
-
-- |Install for ghc, .hi, .a and, if --with-ghci given, .o
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath -- ^install location
- -> FilePath -- ^install location for dynamic librarys
+ -> FilePath -- ^install location for dynamic libraries
-> FilePath -- ^Build location
-> PackageDescription
-> Library
@@ -1269,31 +1260,34 @@
-> IO ()
installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do
-- copy .hi files over:
- let copyHelper installFun src dst n = do
- createDirectoryIfMissingVerbose verbosity True dst
- installFun verbosity (src n) (dst n)
- copy = copyHelper installOrdinaryFile
- copyShared = copyHelper installExecutableFile
- copyModuleFiles ext =
- findModuleFiles [builtDir] [ext] (libModules lib)
- >>= installOrdinaryFiles verbosity targetDir
whenVanilla $ copyModuleFiles "hi"
whenProf $ copyModuleFiles "p_hi"
whenShared $ copyModuleFiles "dyn_hi"
-- copy the built library files over:
- whenVanilla $ mapM_ (copy builtDir targetDir) vanillaLibNames
- whenProf $ mapM_ (copy builtDir targetDir) profileLibNames
- whenGHCi $ mapM_ (copy builtDir targetDir) ghciLibNames
- whenShared $ mapM_ (copyShared builtDir dynlibTargetDir) sharedLibNames
-
- -- run ranlib if necessary:
- whenVanilla $ mapM_ (updateLibArchive verbosity lbi . (targetDir ))
- vanillaLibNames
- whenProf $ mapM_ (updateLibArchive verbosity lbi . (targetDir ))
- profileLibNames
+ 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
@@ -1308,18 +1302,6 @@
whenGHCi = when (hasLib && withGHCiLib lbi)
whenShared = when (hasLib && withSharedLib lbi)
--- | On MacOS X we have to call @ranlib@ to regenerate the archive index after
--- copying. This is because the silly MacOS X linker checks that the archive
--- index is not older than the file itself, which means simply
--- copying/installing the file breaks it!!
---
-updateLibArchive :: Verbosity -> LocalBuildInfo -> FilePath -> IO ()
-updateLibArchive verbosity lbi path
- | buildOS == OSX = do
- (ranlib, _) <- requireProgram verbosity ranlibProgram (withPrograms lbi)
- rawSystemProgram verbosity ranlib [path]
- | otherwise = return ()
-
-- -----------------------------------------------------------------------------
-- Registering
@@ -1353,16 +1335,14 @@
-- -----------------------------------------------------------------------------
-- Utils
-ghcDynamic :: Verbosity -> ConfiguredProgram -> IO Bool
-ghcDynamic verbosity ghcProg
- = do xs <- getGhcInfo verbosity ghcProg
- return $ case lookup "GHC Dynamic" xs of
- Just "YES" -> True
- _ -> False
+ghcLookupProperty :: String -> Compiler -> Bool
+ghcLookupProperty prop comp =
+ case M.lookup prop (compilerProperties comp) of
+ Just "YES" -> True
+ _ -> False
-ghcSupportsDynamicToo :: Verbosity -> ConfiguredProgram -> IO Bool
-ghcSupportsDynamicToo verbosity ghcProg
- = do xs <- getGhcInfo verbosity ghcProg
- return $ case lookup "Support dynamic-too" xs of
- Just "YES" -> True
- _ -> False
+ghcDynamic :: Compiler -> Bool
+ghcDynamic = ghcLookupProperty "GHC Dynamic"
+
+ghcSupportsDynamicToo :: Compiler -> Bool
+ghcSupportsDynamicToo = 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
@@ -2,40 +2,11 @@
-- |
-- Module : Distribution.Simple.GHC.IPI641
-- Copyright : (c) The University of Glasgow 2004
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-
-{- 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. -}
module Distribution.Simple.GHC.IPI641 (
InstalledPackageInfo,
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
@@ -2,40 +2,11 @@
-- |
-- Module : Distribution.Simple.GHC.IPI642
-- Copyright : (c) The University of Glasgow 2004
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-
-{- 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. -}
module Distribution.Simple.GHC.IPI642 (
InstalledPackageInfo,
diff --git a/Distribution/Simple/Haddock.hs b/Distribution/Simple/Haddock.hs
--- a/Distribution/Simple/Haddock.hs
+++ b/Distribution/Simple/Haddock.hs
@@ -2,49 +2,25 @@
-- |
-- Module : Distribution.Simple.Haddock
-- Copyright : Isaac Jones 2003-2005
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
--- This module deals with the @haddock@ and @hscolour@ commands.
--- It uses information about installed packages (from @ghc-pkg@) to find the
--- locations of documentation for dependent packages, so it can create links.
+-- This module deals with the @haddock@ and @hscolour@ commands. Sadly this is a
+-- rather complicated module. It deals with two versions of haddock (0.x and
+-- 2.x). It has to do pre-processing which involves \'unlit\'ing and using
+-- @-D__HADDOCK__@ for any source code that uses @cpp@. It uses information
+-- about installed packages (from @ghc-pkg@) to find the locations of
+-- documentation for dependent packages, so it can create links.
--
--- The @hscolour@ support allows generating html versions of the original
+-- The @hscolour@ support allows generating HTML versions of the original
-- source, with coloured syntax highlighting.
-{- 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 Isaac Jones 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. -}
-
module Distribution.Simple.Haddock (
- haddock, hscolour
+ haddock, hscolour,
+
+ haddockPackagePaths
) where
-- local
@@ -54,7 +30,7 @@
, PackageName(..), packageName )
import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription as PD
- ( PackageDescription(..), BuildInfo(..), usedExtensions
+ ( PackageDescription(..), BuildInfo(..), allExtensions
, Library(..), hasLibs, Executable(..)
, TestSuite(..), TestSuiteInterface(..)
, Benchmark(..), BenchmarkInterface(..) )
@@ -67,7 +43,8 @@
( ConfiguredProgram(..), requireProgramVersion
, rawSystemProgram, rawSystemProgramStdout
, hscolourProgram, haddockProgram )
-import Distribution.Simple.PreProcess (PPSuffixHandler
+import Distribution.Simple.PreProcess (ppCpp', ppUnlit
+ , PPSuffixHandler, runSimplePreProcessor
, preprocessComponent)
import Distribution.Simple.Setup
( defaultHscolourFlags, Flag(..), toFlag, flagToMaybe, flagToList, fromFlag
@@ -102,17 +79,20 @@
import Distribution.Verbosity
import Language.Haskell.Extension
-- Base
-import System.Directory(doesFileExist)
+import System.Directory(removeFile, doesFileExist, createDirectoryIfMissing)
-import Control.Monad ( when, forM_ )
+import Control.Monad ( when, guard, forM_ )
+import Control.Exception (assert)
+import Data.Either ( rights )
import Data.Monoid
import Data.Maybe ( fromMaybe, listToMaybe )
-import System.FilePath((), (<.>),
+import System.FilePath((), (<.>), splitFileName, splitExtension,
normalise, splitPath, joinPath, isAbsolute )
-import System.IO (hClose, hPutStrLn)
+import System.IO (hClose, hPutStrLn, hSetEncoding, utf8)
import Distribution.Version
+-- ------------------------------------------------------------------------------
-- Types
-- | record that represents the arguments to the haddock executable, a product monoid.
@@ -120,18 +100,18 @@
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, -- ^ ingore export lists in modules?
- argLinkSource :: Flag (Template,Template), -- ^ (template for modules, template for symbols)
- argCssFile :: Flag FilePath, -- ^ optinal custom css file.
- argContents :: Flag String, -- ^ optional url to contents page
+ 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)]
+ 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.
+ argGhcOptions :: Flag (GhcOptions, Version), -- ^ additional flags to pass to ghc for haddock-2
+ argGhcLibDir :: Flag FilePath, -- ^ to find the correct ghc, required by haddock-2.
argTargets :: [FilePath] -- ^ modules to process.
}
@@ -145,7 +125,7 @@
data Output = Html | Hoogle
--- --------------------------------------------------------------------------
+-- ------------------------------------------------------------------------------
-- Haddock support
haddock :: PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HaddockFlags -> IO ()
@@ -164,26 +144,33 @@
setupMessage verbosity "Running Haddock for" (packageId pkg_descr)
(confHaddock, version, _) <-
requireProgramVersion verbosity haddockProgram
- (orLaterVersion (Version [2,0] [])) (withPrograms lbi)
+ (orLaterVersion (Version [0,6] [])) (withPrograms lbi)
-- various sanity checks
+ let isVersion2 = version >= Version [2,0] []
+
when ( flag haddockHoogle
+ && version > Version [2] []
&& version < Version [2,2] []) $
die "haddock 2.0 and 2.1 do not support the --hoogle flag."
- haddockGhcVersionStr <- rawSystemProgramStdout verbosity confHaddock
- ["--ghc-version"]
- case simpleParse haddockGhcVersionStr of
- Nothing -> die "Could not get GHC version from Haddock"
- Just haddockGhcVersion
- | 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 (compiler lbi)
+ when (flag haddockHscolour && version < Version [0,8] []) $
+ die "haddock --hyperlink-source requires Haddock version 0.8 or later"
+ when isVersion2 $ do
+ haddockGhcVersionStr <- rawSystemProgramStdout verbosity confHaddock
+ ["--ghc-version"]
+ case simpleParse haddockGhcVersionStr of
+ Nothing -> die "Could not get GHC version from Haddock"
+ Just haddockGhcVersion
+ | 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
@@ -191,37 +178,39 @@
when (flag haddockHscolour) $ hscolour' pkg_descr lbi suffixes $
defaultHscolourFlags `mappend` haddockToHscolour flags
- libdirArgs <- getGhcLibDir verbosity lbi
+ libdirArgs <- getGhcLibDir verbosity lbi isVersion2
let commonArgs = mconcat
[ libdirArgs
, fromFlags (haddockTemplateEnv lbi (packageId pkg_descr)) flags
, fromPackageDescription pkg_descr ]
let pre c = preprocessComponent pkg_descr c lbi False verbosity suffixes
- withAllComponentsInBuildOrder pkg_descr lbi $ \comp clbi -> do
- pre comp
+ withAllComponentsInBuildOrder pkg_descr lbi $ \component clbi -> do
+ pre component
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 confHaddock exeArgs'
+ let bi = buildInfo exe
+ exeArgs <- fromExecutable verbosity tmp lbi exe clbi htmlTemplate
+ exeArgs' <- prepareSources verbosity tmp
+ lbi version bi (commonArgs `mappend` exeArgs)
+ runHaddock verbosity tmpFileOpts comp confHaddock exeArgs'
Nothing -> do
warn (fromFlag $ haddockVerbosity flags)
"Unsupported component, skipping..."
return ()
- case comp of
+ 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 confHaddock libArgs'
- CExe _ -> when (flag haddockExecutables) $ doExe comp
- CTest _ -> when (flag haddockTestSuites) $ doExe comp
- CBench _ -> when (flag haddockBenchmarks) $ doExe comp
+ let bi = libBuildInfo lib
+ libArgs <- fromLibrary verbosity tmp lbi lib clbi htmlTemplate
+ libArgs' <- prepareSources verbosity tmp
+ lbi version bi (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
forM_ (extraDocFiles pkg_descr) $ \ fpath -> do
files <- matchFileGlob fpath
@@ -229,10 +218,55 @@
where
verbosity = flag haddockVerbosity
keepTempFiles = flag haddockKeepTempFiles
+ comp = compiler lbi
tmpFileOpts = defaultTempFileOptions { optKeepTempFiles = keepTempFiles }
flag f = fromFlag $ f flags
htmlTemplate = fmap toPathTemplate . flagToMaybe . haddockHtmlLocation $ flags
+-- | performs cpp and unlit preprocessing where needed on the files in
+-- | argTargets, which must have an .hs or .lhs extension.
+prepareSources :: Verbosity
+ -> FilePath
+ -> LocalBuildInfo
+ -> Version
+ -> BuildInfo
+ -> HaddockArgs
+ -> IO HaddockArgs
+prepareSources verbosity tmp lbi haddockVersion bi args@HaddockArgs{argTargets=files} =
+ mapM (mockPP tmp) files >>= \targets -> return args {argTargets=targets}
+ where
+ mockPP pref file = do
+ let (filePref, fileName) = splitFileName file
+ targetDir = pref filePref
+ targetFile = targetDir fileName
+ (targetFileNoext, targetFileExt) = splitExtension $ targetFile
+ hsFile = targetFileNoext <.> "hs"
+
+ assert (targetFileExt `elem` [".lhs",".hs"]) $ return ()
+
+ createDirectoryIfMissing True targetDir
+
+ if needsCpp
+ then do
+ runSimplePreProcessor (ppCpp' defines bi lbi)
+ file targetFile verbosity
+ else
+ copyFileVerbose verbosity file targetFile
+
+ when (targetFileExt == ".lhs") $ do
+ runSimplePreProcessor ppUnlit targetFile hsFile verbosity
+ removeFile targetFile
+
+ return hsFile
+ needsCpp = EnableExtension CPP `elem` allExtensions bi
+ isVersion2 = haddockVersion >= Version [2,0] []
+ defines | isVersion2 = [haddockVersionMacro]
+ | otherwise = ["-D__HADDOCK__", haddockVersionMacro]
+ haddockVersionMacro = "-D__HADDOCK_VERSION__="
+ ++ show (v1 * 1000 + v2 * 10 + v3)
+ where
+ [v1, v2, v3] = take 3 $ versionBranch haddockVersion ++ [0,0]
+
-- ------------------------------------------------------------------------------
-- Contributions to HaddockArgs.
@@ -242,7 +276,8 @@
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#%{NAME}"
+ ,"src/%{MODULE/./-}.html#line-%{LINE}")
else NoFlag,
argCssFile = haddockCss flags,
argContents = fmap (fromPathTemplate . substPathTemplate env) (haddockContents flags),
@@ -273,10 +308,9 @@
fromLibrary :: Verbosity
-> FilePath
-> LocalBuildInfo -> Library -> ComponentLocalBuildInfo
- -> Maybe PathTemplate -- ^ template for html location
- -> Version
+ -> Maybe PathTemplate -- ^ template for HTML location
-> IO HaddockArgs
-fromLibrary verbosity tmp lbi lib clbi htmlTemplate haddockVersion = do
+fromLibrary verbosity tmp lbi lib clbi htmlTemplate = do
inFiles <- map snd `fmap` getLibSourceFiles lbi lib
ifaceArgs <- getInterfaces verbosity lbi clbi htmlTemplate
let vanillaOpts = (componentGhcOptions normal lbi bi clbi (buildDir lbi)) {
@@ -287,7 +321,7 @@
ghcOptObjDir = toFlag tmp,
ghcOptHiDir = toFlag tmp,
ghcOptStubDir = toFlag tmp
- } `mappend` getGhcCppOpts haddockVersion bi
+ }
sharedOpts = vanillaOpts {
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptFPic = toFlag True,
@@ -312,10 +346,9 @@
fromExecutable :: Verbosity
-> FilePath
-> LocalBuildInfo -> Executable -> ComponentLocalBuildInfo
- -> Maybe PathTemplate -- ^ template for html location
- -> Version
+ -> Maybe PathTemplate -- ^ template for HTML location
-> IO HaddockArgs
-fromExecutable verbosity tmp lbi exe clbi htmlTemplate haddockVersion = do
+fromExecutable verbosity tmp lbi exe clbi htmlTemplate = do
inFiles <- map snd `fmap` getExeSourceFiles lbi exe
ifaceArgs <- getInterfaces verbosity lbi clbi htmlTemplate
let vanillaOpts = (componentGhcOptions normal lbi bi clbi (buildDir lbi)) {
@@ -326,7 +359,7 @@
ghcOptObjDir = toFlag tmp,
ghcOptHiDir = toFlag tmp,
ghcOptStubDir = toFlag tmp
- } `mappend` getGhcCppOpts haddockVersion bi
+ }
sharedOpts = vanillaOpts {
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptFPic = toFlag True,
@@ -370,7 +403,7 @@
getInterfaces :: Verbosity
-> LocalBuildInfo
-> ComponentLocalBuildInfo
- -> Maybe PathTemplate -- ^ template for html location
+ -> Maybe PathTemplate -- ^ template for HTML location
-> IO HaddockArgs
getInterfaces verbosity lbi clbi htmlTemplate = do
(packageFlags, warnings) <- haddockPackageFlags lbi clbi htmlTemplate
@@ -379,40 +412,29 @@
argInterfaces = packageFlags
}
-getGhcCppOpts :: Version
- -> BuildInfo
- -> GhcOptions
-getGhcCppOpts haddockVersion bi =
- mempty {
- ghcOptExtensions = [EnableExtension CPP | needsCpp],
- ghcOptCppOptions = defines
- }
- where
- needsCpp = EnableExtension CPP `elem` usedExtensions bi
- defines = [haddockVersionMacro]
- haddockVersionMacro = "-D__HADDOCK_VERSION__="
- ++ show (v1 * 1000 + v2 * 10 + v3)
- where
- [v1, v2, v3] = take 3 $ versionBranch haddockVersion ++ [0,0]
-
getGhcLibDir :: Verbosity -> LocalBuildInfo
+ -> Bool -- ^ are we using haddock-2.x ?
-> IO HaddockArgs
-getGhcLibDir verbosity lbi = do
- l <- ghcLibDir verbosity lbi
- return $ mempty { argGhcLibDir = Flag l }
-
-----------------------------------------------------------------------------------------------
+getGhcLibDir verbosity lbi isVersion2
+ | isVersion2 =
+ do l <- ghcLibDir verbosity lbi
+ return $ mempty { argGhcLibDir = Flag l }
+ | otherwise =
+ return mempty
+-- ------------------------------------------------------------------------------
-- | Call haddock with the specified arguments.
runHaddock :: Verbosity
-> TempFileOptions
+ -> Compiler
-> ConfiguredProgram
-> HaddockArgs
-> IO ()
-runHaddock verbosity tmpFileOpts confHaddock args = do
+runHaddock verbosity tmpFileOpts comp confHaddock args = do
let haddockVersion = fromMaybe (error "unable to determine haddock version")
(programVersion confHaddock)
- renderArgs verbosity tmpFileOpts haddockVersion args $ \(flags,result)-> do
+ renderArgs verbosity tmpFileOpts haddockVersion comp args $
+ \(flags,result)-> do
rawSystemProgram verbosity confHaddock flags
@@ -422,18 +444,21 @@
renderArgs :: Verbosity
-> TempFileOptions
-> Version
+ -> Compiler
-> HaddockArgs
-> (([String], FilePath) -> IO a)
-> IO a
-renderArgs verbosity tmpFileOpts version args k = do
+renderArgs verbosity tmpFileOpts version comp args k = do
createDirectoryIfMissingVerbose verbosity True outputDir
withTempFileEx tmpFileOpts outputDir "haddock-prolog.txt" $ \prologFileName h -> do
do
+ when (version >= Version [2,15] []) (hSetEncoding h utf8)
hPutStrLn h $ fromFlag $ argPrologue args
hClose h
let pflag = "--prologue=" ++ prologFileName
- k (pflag : renderPureArgs version args, result)
+ k (pflag : renderPureArgs version comp args, result)
where
+ isVersion2 = version >= Version [2,0] []
outputDir = (unDir $ argOutputDir args)
result = intercalate ", "
. map (\o -> outputDir
@@ -442,21 +467,26 @@
Hoogle -> pkgstr <.> "txt")
$ arg argOutput
where
- pkgstr = display $ packageName pkgid
+ pkgstr | isVersion2 = display $ packageName pkgid
+ | otherwise = display pkgid
pkgid = arg argPackageName
arg f = fromFlag $ f args
-renderPureArgs :: Version -> HaddockArgs -> [String]
-renderPureArgs version args = concat
+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,
+ (\pname -> if isVersion2
+ then ["--optghc=-package-name", "--optghc=" ++ pname]
+ else ["--package=" ++ 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) -> ["--source-module=" ++ m
- ,"--source-entity=" ++ e]) . flagToMaybe . argLinkSource $ 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,
@@ -465,9 +495,10 @@
(:[]).("--odir="++) . unDir . argOutputDir $ args,
(:[]).("--title="++) . (bool (++" (internal documentation)") id (getAny $ argIgnoreExports args))
. fromFlag . argTitle $ args,
- [ "--optghc=" ++ opt | (opts, ghcVersion) <- flagToList (argGhcOptions args)
- , opt <- renderGhcOptions ghcVersion opts ],
- maybe [] (\l -> ["-B"++l]) $ flagToMaybe (argGhcLibDir args), -- error if Nothing?
+ [ "--optghc=" ++ opt | isVersion2
+ , (opts, _ghcVer) <- flagToList (argGhcOptions args)
+ , opt <- renderGhcOptions comp opts ],
+ maybe [] (\l -> ["-B"++l]) $ guard isVersion2 >> flagToMaybe (argGhcLibDir args), -- error if isVersion2 and Nothing?
argTargets $ args
]
where
@@ -475,24 +506,21 @@
map (\(i,mh) -> "--read-interface=" ++
maybe "" (++",") mh ++ i)
bool a b c = if c then a else b
- isVersion2_5 = version >= Version [2,5] []
+ isVersion2 = version >= Version [2,0] []
+ isVersion2_5 = version >= Version [2,5] []
+ isVersion2_14 = version >= Version [2,14] []
verbosityFlag
| isVersion2_5 = "--verbosity=1"
| otherwise = "--verbose"
------------------------------------------------------------------------------------------------------------
+---------------------------------------------------------------------------------
-haddockPackageFlags :: LocalBuildInfo
- -> ComponentLocalBuildInfo
- -> Maybe PathTemplate
- -> IO ([(FilePath,Maybe String)], Maybe String)
-haddockPackageFlags lbi clbi htmlTemplate = do
- let allPkgs = installedPkgs lbi
- directDeps = map fst (componentPackageDeps clbi)
- transitiveDeps <- case dependencyClosure allPkgs directDeps of
- Left x -> return x
- Right inf -> die $ "internal error when calculating transative "
- ++ "package dependencies.\nDebug info: " ++ show inf
+-- | Given a list of 'InstalledPackageInfo's, return a list of interfaces and
+-- HTML paths, and an optional warning for packages with missing documentation.
+haddockPackagePaths :: [InstalledPackageInfo]
+ -> Maybe (InstalledPackageInfo -> FilePath)
+ -> IO ([(FilePath, Maybe FilePath)], Maybe String)
+haddockPackagePaths ipkgs mkHtmlPath = do
interfaces <- sequence
[ case interfaceAndHtmlPath ipkg of
Nothing -> return (Left (packageId ipkg))
@@ -500,48 +528,66 @@
exists <- doesFileExist interface
if exists
then return (Right (interface, html))
- else return (Left (packageId ipkg))
- | ipkg <- PackageIndex.allPackages transitiveDeps
- , pkgName (packageId ipkg) `notElem` noHaddockWhitelist
+ else return (Left pkgid)
+ | ipkg <- ipkgs, let pkgid = packageId ipkg
+ , pkgName pkgid `notElem` noHaddockWhitelist
]
let missing = [ pkgid | Left pkgid <- interfaces ]
warning = "The documentation for the following packages are not "
++ "installed. No links will be generated to these packages: "
++ intercalate ", " (map display missing)
- flags = [ (interface, if null html then Nothing else Just html)
- | Right (interface, html) <- interfaces ]
+ flags = rights interfaces
return (flags, if null missing then Nothing else Just warning)
where
+ -- Don't warn about missing documentation for these packages. See #1231.
noHaddockWhitelist = map PackageName [ "rts" ]
- interfaceAndHtmlPath :: InstalledPackageInfo -> Maybe (FilePath, FilePath)
+
+ -- Actually extract interface and HTML paths from an 'InstalledPackageInfo'.
+ interfaceAndHtmlPath :: InstalledPackageInfo
+ -> Maybe (FilePath, Maybe FilePath)
interfaceAndHtmlPath pkg = do
interface <- listToMaybe (InstalledPackageInfo.haddockInterfaces pkg)
- html <- case htmlTemplate of
+ html <- case mkHtmlPath of
Nothing -> fmap fixFileUrl
(listToMaybe (InstalledPackageInfo.haddockHTMLs pkg))
- Just htmlPathTemplate -> Just (expandTemplateVars htmlPathTemplate)
- return (interface, html)
-
+ Just mkPath -> Just (mkPath pkg)
+ return (interface, if null html then Nothing else Just html)
where
- expandTemplateVars = fromPathTemplate . substPathTemplate env
- env = haddockTemplateEnv lbi (packageId pkg)
-
- -- the 'haddock-html' field in the hc-pkg output is often set as a
- -- native path, but we need it as a URL.
- -- See https://github.com/haskell/cabal/issues/1064
+ -- The 'haddock-html' field in the hc-pkg output is often set as a
+ -- native path, but we need it as a URL. See #1064.
fixFileUrl f | isAbsolute f = "file://" ++ f
| otherwise = f
+haddockPackageFlags :: LocalBuildInfo
+ -> ComponentLocalBuildInfo
+ -> Maybe PathTemplate
+ -> IO ([(FilePath, Maybe FilePath)], Maybe String)
+haddockPackageFlags lbi clbi htmlTemplate = do
+ let allPkgs = installedPkgs lbi
+ directDeps = map fst (componentPackageDeps clbi)
+ transitiveDeps <- case dependencyClosure allPkgs directDeps of
+ Left x -> return x
+ Right inf -> die $ "internal error when calculating transitive "
+ ++ "package dependencies.\nDebug info: " ++ show inf
+ haddockPackagePaths (PackageIndex.allPackages transitiveDeps) mkHtmlPath
+ where
+ mkHtmlPath = fmap expandTemplateVars htmlTemplate
+ expandTemplateVars tmpl pkg =
+ fromPathTemplate . substPathTemplate (env pkg) $ tmpl
+ env pkg = haddockTemplateEnv lbi (packageId pkg)
+
+
haddockTemplateEnv :: LocalBuildInfo -> PackageIdentifier -> PathTemplateEnv
-haddockTemplateEnv lbi pkg_id = (PrefixVar, prefix (installDirTemplates lbi))
- : initialPathTemplateEnv pkg_id (compilerId (compiler lbi))
- (hostPlatform lbi)
+haddockTemplateEnv lbi pkg_id =
+ (PrefixVar, prefix (installDirTemplates lbi))
+ : initialPathTemplateEnv pkg_id (compilerId (compiler lbi))
+ (hostPlatform lbi)
--- --------------------------------------------------------------------------
--- hscolour support
+-- ------------------------------------------------------------------------------
+-- hscolour support.
hscolour :: PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HscolourFlags -> IO ()
hscolour pkg_descr lbi suffixes flags = do
@@ -618,7 +664,7 @@
hscolourVerbosity = haddockVerbosity flags,
hscolourDistPref = haddockDistPref flags
}
-----------------------------------------------------------------------------------------------
+---------------------------------------------------------------------------------
-- TODO these should be moved elsewhere.
getLibSourceFiles :: LocalBuildInfo
@@ -655,12 +701,8 @@
exeBuildDir :: LocalBuildInfo -> Executable -> FilePath
exeBuildDir lbi exe = buildDir lbi exeName exe exeName exe ++ "-tmp"
----------------------------------------------------------------------------------------------
-
-
-
-
--- boilerplate monoid instance.
+-- ------------------------------------------------------------------------------
+-- Boilerplate Monoid instance.
instance Monoid HaddockArgs where
mempty = HaddockArgs {
argInterfaceFile = mempty,
diff --git a/Distribution/Simple/HaskellSuite.hs b/Distribution/Simple/HaskellSuite.hs
new file mode 100644
--- /dev/null
+++ b/Distribution/Simple/HaskellSuite.hs
@@ -0,0 +1,222 @@
+module Distribution.Simple.HaskellSuite where
+
+import Control.Monad
+import Control.Applicative
+import Data.Maybe
+import Data.Version
+import qualified Data.Map as M (empty)
+
+import Distribution.Simple.Program
+import Distribution.Simple.Compiler as Compiler
+import Distribution.Simple.Utils
+import Distribution.Simple.BuildPaths
+import Distribution.Verbosity
+import Distribution.Text
+import Distribution.Package
+import Distribution.InstalledPackageInfo hiding (includeDirs)
+import Distribution.Simple.PackageIndex as PackageIndex
+import Distribution.PackageDescription
+import Distribution.Simple.LocalBuildInfo
+import Distribution.System (Platform)
+import Distribution.Compat.Exception
+import Language.Haskell.Extension
+import Distribution.Simple.Program.Builtin
+ (haskellSuiteProgram, haskellSuitePkgProgram)
+
+configure
+ :: Verbosity -> Maybe FilePath -> Maybe FilePath
+ -> ProgramConfiguration -> IO (Compiler, Maybe Platform, ProgramConfiguration)
+configure verbosity mbHcPath hcPkgPath conf0 = do
+
+ -- We have no idea how a haskell-suite tool is named, so we require at
+ -- least some information from the user.
+ hcPath <-
+ let msg = "You have to provide name or path of a haskell-suite tool (-w PATH)"
+ in maybe (die msg) return mbHcPath
+
+ when (isJust hcPkgPath) $
+ warn verbosity "--with-hc-pkg option is ignored for haskell-suite"
+
+ (comp, confdCompiler, conf1) <- configureCompiler hcPath conf0
+
+ -- Update our pkg tool. It uses the same executable as the compiler, but
+ -- all command start with "pkg"
+ (confdPkg, _) <- requireProgram verbosity haskellSuitePkgProgram conf1
+ let conf2 =
+ updateProgram
+ confdPkg
+ { programLocation = programLocation confdCompiler
+ , programDefaultArgs = ["pkg"]
+ }
+ conf1
+
+ return (comp, Nothing, conf2)
+
+ where
+ configureCompiler hcPath conf0' = do
+ let
+ haskellSuiteProgram' =
+ haskellSuiteProgram
+ { programFindLocation = \v _p -> findProgramLocation v hcPath }
+
+ -- NB: cannot call requireProgram right away — it'd think that
+ -- the program is already configured and won't reconfigure it again.
+ -- Instead, call configureProgram directly first.
+ conf1 <- configureProgram verbosity haskellSuiteProgram' conf0'
+ (confdCompiler, conf2) <- requireProgram verbosity haskellSuiteProgram' conf1
+
+ extensions <- getExtensions verbosity confdCompiler
+ languages <- getLanguages verbosity confdCompiler
+ (compName, compVersion) <-
+ getCompilerVersion verbosity confdCompiler
+
+ let
+ comp = Compiler {
+ compilerId = CompilerId (HaskellSuite compName) compVersion,
+ compilerLanguages = languages,
+ compilerExtensions = extensions,
+ compilerProperties = M.empty
+ }
+
+ return (comp, confdCompiler, conf2)
+
+hstoolVersion :: Verbosity -> FilePath -> IO (Maybe Version)
+hstoolVersion = findProgramVersion "--hspkg-version" id
+
+numericVersion :: Verbosity -> FilePath -> IO (Maybe Version)
+numericVersion = findProgramVersion "--compiler-version" (last . words)
+
+getCompilerVersion :: Verbosity -> ConfiguredProgram -> IO (String, Version)
+getCompilerVersion verbosity prog = do
+ output <- rawSystemStdout verbosity (programPath prog) ["--compiler-version"]
+ let
+ parts = words output
+ name = concat $ init parts -- there shouldn't be any spaces in the name anyway
+ versionStr = last parts
+ version <-
+ maybe (die "haskell-suite: couldn't determine compiler version") return $
+ simpleParse versionStr
+ return (name, version)
+
+getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Compiler.Flag)]
+getExtensions verbosity prog = do
+ extStrs <-
+ lines <$>
+ rawSystemStdout verbosity (programPath prog) ["--supported-extensions"]
+ return
+ [ (ext, "-X" ++ display ext) | Just ext <- map simpleParse extStrs ]
+
+getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, Compiler.Flag)]
+getLanguages verbosity prog = do
+ langStrs <-
+ lines <$>
+ rawSystemStdout verbosity (programPath prog) ["--supported-languages"]
+ return
+ [ (ext, "-G" ++ display ext) | Just ext <- map simpleParse langStrs ]
+
+-- 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
+getInstalledPackages verbosity packagedbs conf =
+ liftM (PackageIndex.fromList . concat) $ forM packagedbs $ \packagedb ->
+ do str <-
+ getDbProgramOutput verbosity haskellSuitePkgProgram conf
+ ["dump", packageDbOpt packagedb]
+ `catchExit` \_ -> die $ "pkg dump failed"
+ case parsePackages str of
+ Right ok -> return ok
+ _ -> die "failed to parse output of 'pkg dump'"
+
+ where
+ parsePackages str =
+ let parsed = map parseInstalledPackageInfo (splitPkgs str)
+ in case [ msg | ParseFailed msg <- parsed ] of
+ [] -> Right [ pkg | ParseOk _ pkg <- parsed ]
+ msgs -> Left msgs
+
+ splitPkgs :: String -> [String]
+ splitPkgs = map unlines . splitWith ("---" ==) . lines
+ where
+ splitWith :: (a -> Bool) -> [a] -> [[a]]
+ splitWith p xs = ys : case zs of
+ [] -> []
+ _:ws -> splitWith p ws
+ where (ys,zs) = break p xs
+
+buildLib
+ :: Verbosity -> PackageDescription -> LocalBuildInfo
+ -> Library -> ComponentLocalBuildInfo -> IO ()
+buildLib verbosity pkg_descr lbi lib clbi = do
+ -- In future, there should be a mechanism for the compiler to request any
+ -- number of the above parameters (or their parts) — in particular,
+ -- pieces of PackageDescription.
+ --
+ -- For now, we only pass those that we know are used.
+
+ let odir = buildDir lbi
+ bi = libBuildInfo lib
+ srcDirs = hsSourceDirs bi ++ [odir]
+ dbStack = withPackageDB lbi
+ language = fromMaybe Haskell98 (defaultLanguage bi)
+ conf = withPrograms lbi
+ pkgid = packageId pkg_descr
+
+ runDbProgram verbosity haskellSuiteProgram conf $
+ [ "compile", "--build-dir", odir ] ++
+ concat [ ["-i", d] | d <- srcDirs ] ++
+ concat [ ["-I", d] | d <- [autogenModulesDir lbi, odir] ++ includeDirs bi ] ++
+ [ packageDbOpt pkgDb | pkgDb <- dbStack ] ++
+ [ "--package-name", display pkgid ] ++
+ concat [ ["--package-id", display ipkgid ]
+ | (ipkgid, _) <- componentPackageDeps clbi ] ++
+ ["-G", display language] ++
+ concat [ ["-X", display ex] | ex <- usedExtensions bi ] ++
+ [ display modu | modu <- libModules lib ]
+
+
+
+installLib
+ :: Verbosity
+ -> LocalBuildInfo
+ -> FilePath -- ^install location
+ -> FilePath -- ^install location for dynamic libraries
+ -> FilePath -- ^Build location
+ -> PackageDescription
+ -> Library
+ -> IO ()
+installLib verbosity lbi targetDir dynlibTargetDir builtDir pkg lib = do
+ let conf = withPrograms lbi
+ runDbProgram verbosity haskellSuitePkgProgram conf $
+ [ "install-library"
+ , "--build-dir", builtDir
+ , "--target-dir", targetDir
+ , "--dynlib-target-dir", dynlibTargetDir
+ , "--package-id", display $ packageId pkg
+ ] ++ map display (libModules lib)
+
+registerPackage
+ :: Verbosity
+ -> InstalledPackageInfo
+ -> PackageDescription
+ -> LocalBuildInfo
+ -> Bool
+ -> PackageDBStack
+ -> IO ()
+registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do
+ (hspkg, _) <- requireProgram verbosity haskellSuitePkgProgram (withPrograms lbi)
+
+ runProgramInvocation verbosity $
+ (programInvocation hspkg
+ ["update", packageDbOpt $ last packageDbs])
+ { progInvokeInput = Just $ showInstalledPackageInfo installedPkgInfo }
+
+initPackageDB :: Verbosity -> ProgramConfiguration -> FilePath -> IO ()
+initPackageDB verbosity conf dbPath =
+ runDbProgram verbosity haskellSuitePkgProgram conf
+ ["init", dbPath]
+
+packageDbOpt :: PackageDB -> String
+packageDbOpt GlobalPackageDB = "--global"
+packageDbOpt UserPackageDB = "--user"
+packageDbOpt (SpecificPackageDB db) = "--package-db=" ++ db
diff --git a/Distribution/Simple/Hpc.hs b/Distribution/Simple/Hpc.hs
--- a/Distribution/Simple/Hpc.hs
+++ b/Distribution/Simple/Hpc.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.Hpc
-- Copyright : Thomas Tuegel 2011
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -9,36 +10,6 @@
-- This module provides functions for locating various HPC-related paths and
-- a function for adding the necessary options to a PackageDescription to
-- build test suites with HPC enabled.
-
-{- 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 Isaac Jones 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. -}
module Distribution.Simple.Hpc
( enableCoverage
diff --git a/Distribution/Simple/Hugs.hs b/Distribution/Simple/Hugs.hs
--- a/Distribution/Simple/Hugs.hs
+++ b/Distribution/Simple/Hugs.hs
@@ -3,6 +3,7 @@
-- Module : Distribution.Simple.Hugs
-- Copyright : Isaac Jones 2003-2006
-- Duncan Coutts 2009
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -10,37 +11,6 @@
-- This module contains most of the NHC-specific code for configuring, building
-- and installing packages.
-{- Copyright (c) 2003-2005, Isaac Jones
-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 Isaac Jones 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. -}
-
module Distribution.Simple.Hugs (
configure,
getInstalledPackages,
@@ -108,6 +78,7 @@
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 )
@@ -138,7 +109,8 @@
let comp = Compiler {
compilerId = CompilerId Hugs version,
compilerLanguages = hugsLanguages,
- compilerExtensions = hugsLanguageExtensions
+ compilerExtensions = hugsLanguageExtensions,
+ compilerProperties = M.empty
}
compPlatform = Nothing
return (comp, compPlatform, conf'')
diff --git a/Distribution/Simple/Install.hs b/Distribution/Simple/Install.hs
--- a/Distribution/Simple/Install.hs
+++ b/Distribution/Simple/Install.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.Install
-- Copyright : Isaac Jones 2003-2004
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -11,36 +12,6 @@
-- place based on the prefix argument. It does the generic bits and then calls
-- compiler-specific functions to do the rest.
-{- 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 Isaac Jones 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. -}
-
module Distribution.Simple.Install (
install,
) where
@@ -67,6 +38,7 @@
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.HaskellSuite as HaskellSuite
import Control.Monad (when, unless)
import System.Directory
@@ -136,10 +108,12 @@
installOrdinaryFile verbosity haddockInterfaceFileSrc
haddockInterfaceFileDest
- let lfile = licenseFile pkg_descr
- unless (null lfile) $ do
+ let lfiles = licenseFiles pkg_descr
+ unless (null lfiles) $ do
createDirectoryIfMissingVerbose verbosity True docPref
- installOrdinaryFile verbosity lfile (docPref takeFileName lfile)
+ sequence_
+ [ installOrdinaryFile verbosity lfile (docPref takeFileName lfile)
+ | lfile <- lfiles ]
let buildPref = buildDir lbi
when (hasLibs pkg_descr) $
@@ -175,6 +149,9 @@
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 $
+ HaskellSuite.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr
_ -> die $ "installing with "
++ display (compilerFlavor (compiler lbi))
++ " is not implemented"
diff --git a/Distribution/Simple/InstallDirs.hs b/Distribution/Simple/InstallDirs.hs
--- a/Distribution/Simple/InstallDirs.hs
+++ b/Distribution/Simple/InstallDirs.hs
@@ -3,6 +3,7 @@
-- |
-- Module : Distribution.Simple.InstallDirs
-- Copyright : Isaac Jones 2003-2004
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -16,36 +17,6 @@
-- provides a 'PathTemplate' type and functions for substituting for these
-- templates.
-{- 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 Isaac Jones 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. -}
-
module Distribution.Simple.InstallDirs (
InstallDirs(..),
InstallDirTemplates,
@@ -92,15 +63,15 @@
#endif
-- ---------------------------------------------------------------------------
--- Instalation directories
+-- Installation directories
-- | The directories where we will install files for packages.
--
-- We have several different directories for different types of files since
-- many systems have conventions whereby different types of files in a package
--- are installed in different direcotries. This is particularly the case on
--- unix style systems.
+-- are installed in different directories. This is particularly the case on
+-- Unix style systems.
--
data InstallDirs dir = InstallDirs {
prefix :: dir,
@@ -197,11 +168,11 @@
-- convenient for the user to override the default installation directory
-- by only having to specify --prefix=... rather than overriding each
-- individually. This is done by allowing $-style variables in the dirs.
--- These are expanded by textual substituion (see 'substPathTemplate').
+-- These are expanded by textual substitution (see 'substPathTemplate').
--
-- A few of these installation directories are split into two components, the
-- dir and subdir. The full installation path is formed by combining the two
--- together with @\/@. The reason for this is compatibility with other unix
+-- together with @\/@. The reason for this is compatibility with other Unix
-- build systems which also support @--libdir@ and @--datadir@. We would like
-- users to be able to configure @--libdir=\/usr\/lib64@ for example but
-- because by default we want to support installing multiple versions of
@@ -365,7 +336,7 @@
-- ---------------------------------------------------------------------------
-- Path templates
--- | An abstract path, posibly containing variables that need to be
+-- | An abstract path, possibly containing variables that need to be
-- substituted for to get a real 'FilePath'.
--
newtype PathTemplate = PathTemplate [PathComponent]
@@ -389,7 +360,7 @@
| PkgIdVar -- ^ The @$pkgid@ package Id path variable, eg @foo-1.0@
| 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@
+ | ArchVar -- ^ The CPU architecture name, eg @i386@ or @x86_64@
| 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
@@ -522,7 +493,7 @@
showList = foldr (\x -> (shows x .)) id
instance Read PathComponent where
- -- for some reason we colapse multiple $ symbols here
+ -- for some reason we collapse multiple $ symbols here
readsPrec _ = lex0
where lex0 [] = []
lex0 ('$':'$':s') = lex0 ('$':s')
diff --git a/Distribution/Simple/JHC.hs b/Distribution/Simple/JHC.hs
--- a/Distribution/Simple/JHC.hs
+++ b/Distribution/Simple/JHC.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.JHC
-- Copyright : Isaac Jones 2003-2006
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -9,39 +10,6 @@
-- This module contains most of the JHC-specific code for configuring, building
-- and installing packages.
-{-
-Copyright (c) 2009, Henning Thielemann
-Copyright (c) 2003-2005, Isaac Jones
-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 Isaac Jones 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. -}
-
module Distribution.Simple.JHC (
configure, getInstalledPackages,
buildLib, buildExe,
@@ -88,6 +56,7 @@
import Data.List ( nub )
import Data.Char ( isSpace )
+import qualified Data.Map as M ( empty )
import Data.Maybe ( fromMaybe )
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
@@ -108,7 +77,8 @@
comp = Compiler {
compilerId = CompilerId JHC version,
compilerLanguages = jhcLanguages,
- compilerExtensions = jhcLanguageExtensions
+ compilerExtensions = jhcLanguageExtensions,
+ compilerProperties = M.empty
}
compPlatform = Nothing
return (comp, compPlatform, conf')
diff --git a/Distribution/Simple/LHC.hs b/Distribution/Simple/LHC.hs
--- a/Distribution/Simple/LHC.hs
+++ b/Distribution/Simple/LHC.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.LHC
-- Copyright : Isaac Jones 2003-2007
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -29,37 +30,6 @@
-- explicitly documented) and thus what search dirs are used for various kinds
-- of files.
-{- Copyright (c) 2003-2005, Isaac Jones
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modiication, 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 Isaac Jones 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. -}
-
module Distribution.Simple.LHC (
configure, getInstalledPackages,
buildLib, buildExe,
@@ -96,7 +66,7 @@
, rawSystemProgramStdout, rawSystemProgramStdoutConf
, requireProgramVersion
, userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
- , arProgram, ranlibProgram, ldProgram
+ , arProgram, ldProgram
, gccProgram, stripProgram
, lhcProgram, lhcPkgProgram )
import qualified Distribution.Simple.Program.HcPkg as HcPkg
@@ -116,6 +86,7 @@
import Control.Monad ( unless, when )
import Data.List
+import qualified Data.Map as M ( empty )
import Data.Maybe ( catMaybes )
import Data.Monoid ( Monoid(..) )
import System.Directory ( removeFile, renameFile,
@@ -155,7 +126,8 @@
let comp = Compiler {
compilerId = CompilerId LHC lhcVersion,
compilerLanguages = languages,
- compilerExtensions = extensions
+ compilerExtensions = extensions,
+ compilerProperties = M.empty
}
conf''' = configureToolchain lhcProg conf'' -- configure gcc and ld
compPlatform = Nothing
@@ -361,7 +333,7 @@
-- TH always needs vanilla libs, even when building for profiling
createDirectoryIfMissingVerbose verbosity True libTargetDir
- -- TODO: do we need to put hs-boot files into place for mutually recurive modules?
+ -- TODO: do we need to put hs-boot files into place for mutually recursive modules?
let ghcArgs =
["-package-name", display pkgid ]
++ constructGHCCmdLine lbi libBi clbi libTargetDir verbosity
@@ -488,10 +460,10 @@
runAr = rawSystemProgramConf verbosity arProgram (withPrograms lbi)
- --TODO: discover this at configure time or runtime on unix
- -- The value is 32k on Windows and posix specifies a minimum of 4k
- -- but all sensible unixes use more than 4k.
- -- we could use getSysVar ArgumentLimit but that's in the unix lib
+ --TODO: discover this at configure time or runtime on Unix
+ -- The value is 32k on Windows and POSIX specifies a minimum of 4k
+ -- but all sensible Unixes use more than 4k.
+ -- we could use getSysVar ArgumentLimit but that's in the Unix lib
maxCommandLineSize = 30 * 1024
ifVanillaLib False $ xargs maxCommandLineSize
@@ -756,7 +728,7 @@
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath -- ^install location
- -> FilePath -- ^install location for dynamic librarys
+ -> FilePath -- ^install location for dynamic libraries
-> FilePath -- ^Build location
-> PackageDescription
-> Library
@@ -781,12 +753,6 @@
ifGHCi $ mapM_ (copy builtDir targetDir) ghciLibNames
ifShared $ mapM_ (copy builtDir dynlibTargetDir) sharedLibNames
- -- run ranlib if necessary:
- ifVanilla $ mapM_ (updateLibArchive verbosity lbi . (targetDir ))
- vanillaLibNames
- ifProf $ mapM_ (updateLibArchive verbosity lbi . (targetDir ))
- profileLibNames
-
where
cid = compilerId (compiler lbi)
libNames = componentLibraries clbi
@@ -803,20 +769,6 @@
ifShared = when (hasLib && withSharedLib lbi)
runLhc = rawSystemProgramConf verbosity lhcProgram (withPrograms lbi)
-
--- | use @ranlib@ or @ar -s@ to build an index. This is necessary on systems
--- like MacOS X. If we can't find those, don't worry too much about it.
---
-updateLibArchive :: Verbosity -> LocalBuildInfo -> FilePath -> IO ()
-updateLibArchive verbosity lbi path =
- case lookupProgram ranlibProgram (withPrograms lbi) of
- Just ranlib -> rawSystemProgram verbosity ranlib [path]
- Nothing -> case lookupProgram arProgram (withPrograms lbi) of
- Just ar -> rawSystemProgram verbosity ar ["-s", path]
- Nothing -> warn verbosity $
- "Unable to generate a symbol index for the static "
- ++ "library '" ++ path
- ++ "' (missing the 'ranlib' and 'ar' programs)"
-- -----------------------------------------------------------------------------
-- Registering
diff --git a/Distribution/Simple/LocalBuildInfo.hs b/Distribution/Simple/LocalBuildInfo.hs
--- a/Distribution/Simple/LocalBuildInfo.hs
+++ b/Distribution/Simple/LocalBuildInfo.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.LocalBuildInfo
-- Copyright : Isaac Jones 2003-2004
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -14,36 +15,6 @@
-- flags. It gets saved and reloaded from a file (@dist\/setup-config@). It gets
-- passed in to very many subsequent build actions.
-{- 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 Isaac Jones 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. -}
-
module Distribution.Simple.LocalBuildInfo (
LocalBuildInfo(..),
externalPackageDeps,
@@ -121,7 +92,7 @@
-- ^ Extra args on the command line for the configuration step.
-- Needed to re-run configuration when .cabal is out of date
installDirTemplates :: InstallDirTemplates,
- -- ^ The installation directories for the various differnt
+ -- ^ The installation directories for the various different
-- kinds of files
--TODO: inplaceDirTemplates :: InstallDirs FilePath
compiler :: Compiler,
@@ -155,6 +126,7 @@
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)
diff --git a/Distribution/Simple/NHC.hs b/Distribution/Simple/NHC.hs
--- a/Distribution/Simple/NHC.hs
+++ b/Distribution/Simple/NHC.hs
@@ -3,6 +3,7 @@
-- Module : Distribution.Simple.NHC
-- Copyright : Isaac Jones 2003-2006
-- Duncan Coutts 2009
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -10,37 +11,6 @@
-- This module contains most of the NHC-specific code for configuring, building
-- and installing packages.
-{- Copyright (c) 2003-2005, Isaac Jones
-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 Isaac Jones 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. -}
-
module Distribution.Simple.NHC (
configure,
getInstalledPackages,
@@ -98,11 +68,12 @@
( doesFileExist, doesDirectoryExist, getDirectoryContents
, removeFile, getHomeDirectory )
-import Data.Char ( toLower )
-import Data.List ( nub )
-import Data.Maybe ( catMaybes )
-import Data.Monoid ( Monoid(..) )
-import Control.Monad ( when, unless )
+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 )
@@ -133,7 +104,8 @@
let comp = Compiler {
compilerId = CompilerId NHC nhcVersion,
compilerLanguages = nhcLanguages,
- compilerExtensions = nhcLanguageExtensions
+ compilerExtensions = nhcLanguageExtensions,
+ compilerProperties = M.empty
}
compPlatform = Nothing
return (comp, compPlatform, conf'''')
diff --git a/Distribution/Simple/PackageIndex.hs b/Distribution/Simple/PackageIndex.hs
--- a/Distribution/Simple/PackageIndex.hs
+++ b/Distribution/Simple/PackageIndex.hs
@@ -89,7 +89,7 @@
-- | The collection of information about packages from one or more 'PackageDB's.
--
-- Packages are uniquely identified in by their 'InstalledPackageId', they can
--- also be effeciently looked up by package name or by name and version.
+-- also be efficiently looked up by package name or by name and version.
--
data PackageIndex = PackageIndex
-- The primary index. Each InstalledPackageInfo record is uniquely identified
@@ -97,7 +97,7 @@
--
!(Map InstalledPackageId InstalledPackageInfo)
- -- This auxillary index maps package names (case-sensitively) to all the
+ -- This auxiliary index maps package names (case-sensitively) to all the
-- versions and instances of that package. This allows us to find all
-- versions satisfying a dependency.
--
@@ -372,12 +372,12 @@
-- | Does a case-insensitive search by package name.
--
--- If there is only one package that compares case-insentiviely to this name
+-- If there is only one package that compares case-insensitively to this name
-- then the search is unambiguous and we get back all versions of that package.
--- If several match case-insentiviely but one matches exactly then it is also
+-- If several match case-insensitively but one matches exactly then it is also
-- unambiguous.
--
--- If however several match case-insentiviely and none match exactly then we
+-- If however several match case-insensitively and none match exactly then we
-- have an ambiguous result, and we get back all the versions of all the
-- packages. The list of ambiguous results is split by exact package name. So
-- it is a non-empty list of non-empty lists.
diff --git a/Distribution/Simple/PreProcess.hs b/Distribution/Simple/PreProcess.hs
--- a/Distribution/Simple/PreProcess.hs
+++ b/Distribution/Simple/PreProcess.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.PreProcess
-- Copyright : (c) 2003-2005, Isaac Jones, Malcolm Wallace
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -16,37 +17,6 @@
-- handlers. This module is not as good as it could be, it could really do with
-- a rewrite to address some of the problems we have with pre-processors.
-{- Copyright (c) 2003-2005, Isaac Jones, Malcolm Wallace
-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 Isaac Jones 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. -}
-
module Distribution.Simple.PreProcess (preprocessComponent, knownSuffixHandlers,
ppSuffixes, PPSuffixHandler, PreProcessor(..),
mkSimplePreProcessor, runSimplePreProcessor,
@@ -84,11 +54,12 @@
, findFileWithExtension, findFileWithExtension' )
import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), programPath
- , requireProgram, requireProgramVersion
+ , lookupProgram, requireProgram, requireProgramVersion
, rawSystemProgramConf, rawSystemProgram
, greencardProgram, cpphsProgram, hsc2hsProgram, c2hsProgram
- , happyProgram, alexProgram, ghcProgram, gccProgram )
-import Distribution.Simple.Test ( writeSimpleTestStub, stubFilePath, stubName )
+ , happyProgram, alexProgram, haddockProgram, ghcProgram, gccProgram )
+import Distribution.Simple.Test.LibV09
+ ( writeSimpleTestStub, stubFilePath, stubName )
import Distribution.System
( OS(..), buildOS, Arch(..), Platform(..) )
import Distribution.Text
@@ -384,6 +355,7 @@
-- double-unlitted. In the future we might switch to
-- using cpphs --unlit instead.
++ (if ghcVersion >= Version [6,6] [] then ["-x", "hs"] else [])
+ ++ (if use_optP_P lbi then ["-optP-P"] else [])
++ [ "-optP-include", "-optP"++ (autogenModulesDir lbi cppHeaderName) ]
++ ["-o", outFile, inFile]
++ extraArgs
@@ -405,6 +377,16 @@
++ extraArgs
}
+-- Haddock versions before 0.8 choke on #line and #file pragmas. Those
+-- pragmas are necessary for correct links when we preprocess. So use
+-- -optP-P only if the Haddock version is prior to 0.8.
+use_optP_P :: LocalBuildInfo -> Bool
+use_optP_P lbi
+ = case lookupProgram haddockProgram (withPrograms lbi) of
+ Just (ConfiguredProgram { programVersion = Just version })
+ | version >= Version [0,8] [] -> False
+ _ -> True
+
ppHsc2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppHsc2hs bi lbi =
PreProcessor {
@@ -442,6 +424,9 @@
++ [ "--cflag=-I" ++ dir | dir <- PD.includeDirs bi ]
++ [ "--cflag=" ++ opt | opt <- PD.ccOptions bi
++ PD.cppOptions bi ]
+ ++ [ "--cflag=" ++ opt | opt <-
+ [ "-I" ++ autogenModulesDir lbi,
+ "-include", autogenModulesDir lbi cppHeaderName ] ]
++ [ "--lflag=-L" ++ opt | opt <- PD.extraLibDirs bi ]
++ [ "--lflag=-Wl,-R," ++ opt | isELF
, opt <- PD.extraLibDirs bi ]
@@ -452,9 +437,7 @@
++ [ "--cflag=" ++ opt
| pkg <- pkgs
, opt <- [ "-I" ++ opt | opt <- Installed.includeDirs pkg ]
- ++ [ opt | opt <- Installed.ccOptions pkg ]
- ++ [ "-I" ++ autogenModulesDir lbi,
- "-include", autogenModulesDir lbi cppHeaderName ] ]
+ ++ [ opt | opt <- Installed.ccOptions pkg ] ]
++ [ "--lflag=" ++ opt
| pkg <- pkgs
, opt <- [ "-L" ++ opt | opt <- Installed.libraryDirs pkg ]
@@ -529,45 +512,18 @@
platformDefines lbi =
case compilerFlavor comp of
GHC ->
- let ghcOS = case hostOS of
- Linux -> ["linux"]
- Windows -> ["mingw32"]
- OSX -> ["darwin"]
- FreeBSD -> ["freebsd"]
- OpenBSD -> ["openbsd"]
- NetBSD -> ["netbsd"]
- Solaris -> ["solaris2"]
- AIX -> ["aix"]
- HPUX -> ["hpux"]
- IRIX -> ["irix"]
- HaLVM -> []
- IOS -> ["ios"]
- OtherOS _ -> []
- ghcArch = case hostArch of
- I386 -> ["i386"]
- X86_64 -> ["x86_64"]
- PPC -> ["powerpc"]
- PPC64 -> ["powerpc64"]
- Sparc -> ["sparc"]
- Arm -> ["arm"]
- Mips -> ["mips"]
- SH -> []
- IA64 -> ["ia64"]
- S390 -> ["s390"]
- Alpha -> ["alpha"]
- Hppa -> ["hppa"]
- Rs6000 -> ["rs6000"]
- M68k -> ["m68k"]
- Vax -> ["vax"]
- OtherArch _ -> []
- in ["-D__GLASGOW_HASKELL__=" ++ versionInt version] ++
- ["-D" ++ os ++ "_BUILD_OS=1"] ++
- ["-D" ++ arch ++ "_BUILD_ARCH=1"] ++
- map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") ghcOS ++
- map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") ghcArch
+ ["-D__GLASGOW_HASKELL__=" ++ 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 ++
+ map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr
_ -> []
where
comp = compiler lbi
@@ -588,6 +544,38 @@
_ : _ : _ -> ""
_ -> "0"
in s1 ++ middle ++ s2
+ osStr = case hostOS of
+ Linux -> ["linux"]
+ Windows -> ["mingw32"]
+ OSX -> ["darwin"]
+ FreeBSD -> ["freebsd"]
+ OpenBSD -> ["openbsd"]
+ NetBSD -> ["netbsd"]
+ DragonFly -> ["dragonfly"]
+ Solaris -> ["solaris2"]
+ AIX -> ["aix"]
+ HPUX -> ["hpux"]
+ IRIX -> ["irix"]
+ HaLVM -> []
+ IOS -> ["ios"]
+ OtherOS _ -> []
+ archStr = case hostArch of
+ I386 -> ["i386"]
+ X86_64 -> ["x86_64"]
+ PPC -> ["powerpc"]
+ PPC64 -> ["powerpc64"]
+ Sparc -> ["sparc"]
+ Arm -> ["arm"]
+ Mips -> ["mips"]
+ SH -> []
+ IA64 -> ["ia64"]
+ S390 -> ["s390"]
+ Alpha -> ["alpha"]
+ Hppa -> ["hppa"]
+ Rs6000 -> ["rs6000"]
+ M68k -> ["m68k"]
+ Vax -> ["vax"]
+ OtherArch _ -> []
ppHappy :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppHappy _ lbi = pp { platformIndependent = True }
diff --git a/Distribution/Simple/Program.hs b/Distribution/Simple/Program.hs
--- a/Distribution/Simple/Program.hs
+++ b/Distribution/Simple/Program.hs
@@ -58,7 +58,7 @@
, runProgramInvocation
, getProgramInvocationOutput
- -- * The collection of unconfigured and configured progams
+ -- * The collection of unconfigured and configured programs
, builtinPrograms
-- * The collection of configured programs we can run
@@ -100,7 +100,6 @@
, ffihugsProgram
, uhcProgram
, gccProgram
- , ranlibProgram
, arProgram
, stripProgram
, happyProgram
@@ -169,8 +168,8 @@
Nothing -> die notFound
Just configuredProg -> runProgram verbosity configuredProg args
where
- notFound = "The program " ++ programName prog
- ++ " is required but it could not be found"
+ notFound = "The program '" ++ programName prog
+ ++ "' is required but it could not be found"
-- | Looks up the given program in the program database and runs it.
--
@@ -184,8 +183,8 @@
Nothing -> die notFound
Just configuredProg -> getProgramOutput verbosity configuredProg args
where
- notFound = "The program " ++ programName prog
- ++ " is required but it could not be found"
+ notFound = "The program '" ++ programName prog
+ ++ "' is required but it could not be found"
---------------------
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
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.Program.Ar
@@ -10,25 +12,45 @@
module Distribution.Simple.Program.Ar (
createArLibArchive,
- multiStageProgramInvocation,
+ multiStageProgramInvocation
) where
-import Distribution.Simple.Program.Types
- ( ConfiguredProgram(..) )
+import Control.Monad (when, unless)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS8
+import Data.Char (isSpace)
+import Distribution.Compat.CopyFile (filesEqual)
+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
+import Distribution.Simple.Program
+ ( arProgram, requireProgram )
import Distribution.Simple.Program.Run
( programInvocation, multiStageProgramInvocation
, runProgramInvocation )
+import qualified Distribution.Simple.Program.Strip as Strip
+ ( stripLib )
+import Distribution.Simple.Utils
+ ( dieWithLocation, withTempDirectory )
import Distribution.System
- ( OS(..), buildOS )
+ ( Arch(..), OS(..), Platform(..) )
import Distribution.Verbosity
( Verbosity, deafening, verbose )
+import System.Directory (doesFileExist, renameFile)
+import System.FilePath ((), splitFileName)
+import System.IO
+ ( Handle, IOMode(ReadWriteMode), SeekMode(AbsoluteSeek)
+ , hFileSize, hSeek, withBinaryFile )
-- | Call @ar@ to create a library archive from a bunch of object files.
--
-createArLibArchive :: Verbosity -> ConfiguredProgram
+createArLibArchive :: Verbosity -> LocalBuildInfo
-> FilePath -> [FilePath] -> IO ()
-createArLibArchive verbosity ar target files =
+createArLibArchive verbosity lbi targetPath files = do
+ (ar, _) <- requireProgram verbosity arProgram progConf
+ let (targetDir, targetName) = splitFileName targetPath
+ withTempDirectory verbosity targetDir targetName $ \ tmpDir -> do
+ let tmpPath = tmpDir targetName
+
-- The args to use with "ar" are actually rather subtle and system-dependent.
-- In particular we have the following issues:
--
@@ -43,28 +65,104 @@
-- When we need to call ar multiple times we use "ar q" and for the last
-- call on OSX we use "ar qs" so that it'll make the index.
- let simpleArgs = case buildOS of
+ let simpleArgs = case hostOS of
OSX -> ["-r", "-s"]
_ -> ["-r"]
initialArgs = ["-q"]
- finalArgs = case buildOS of
+ finalArgs = case hostOS of
OSX -> ["-q", "-s"]
_ -> ["-q"]
- extraArgs = verbosityOpts verbosity ++ [target]
+ extraArgs = verbosityOpts verbosity ++ [tmpPath]
simple = programInvocation ar (simpleArgs ++ extraArgs)
initial = programInvocation ar (initialArgs ++ extraArgs)
middle = initial
final = programInvocation ar (finalArgs ++ extraArgs)
- in sequence_
+ sequence_
[ runProgramInvocation verbosity inv
| inv <- multiStageProgramInvocation
simple (initial, middle, final) files ]
+ when stripLib $ Strip.stripLib verbosity platform progConf tmpPath
+ unless (hostArch == Arm) $ -- See #1537
+ wipeMetadata tmpPath
+ equal <- filesEqual tmpPath targetPath
+ unless equal $ renameFile tmpPath targetPath
+
where
+ progConf = withPrograms lbi
+ stripLib = stripLibs lbi
+ platform@(Platform hostArch hostOS) = hostPlatform lbi
verbosityOpts v | v >= deafening = ["-v"]
| v >= verbose = []
| otherwise = ["-c"]
+
+-- | @ar@ by default includes various metadata for each object file in their
+-- respective headers, so the output can differ for the same inputs, making
+-- it difficult to avoid re-linking. GNU @ar@(1) has a deterministic mode
+-- (@-D@) flag that always writes zero for the mtime, UID and GID, and 0644
+-- for the file mode. However detecting whether @-D@ is supported seems
+-- rather harder than just re-implementing this feature.
+wipeMetadata :: FilePath -> IO ()
+wipeMetadata path = do
+ -- Check for existence first (ReadWriteMode would create one otherwise)
+ exists <- doesFileExist path
+ unless exists $ wipeError "Temporary file disappeared"
+ withBinaryFile path ReadWriteMode $ \ h -> hFileSize h >>= wipeArchive h
+
+ where
+ wipeError msg = dieWithLocation path Nothing $
+ "Distribution.Simple.Program.Ar.wipeMetadata: " ++ msg
+ archLF = "!\x0a" -- global magic, 8 bytes
+ x60LF = "\x60\x0a" -- header magic, 2 bytes
+ metadata = BS.concat
+ [ "0 " -- mtime, 12 bytes
+ , "0 " -- UID, 6 bytes
+ , "0 " -- GID, 6 bytes
+ , "0644 " -- mode, 8 bytes
+ ]
+ headerSize = 60
+
+ -- http://en.wikipedia.org/wiki/Ar_(Unix)#File_format_details
+ wipeArchive :: Handle -> Integer -> IO ()
+ wipeArchive h archiveSize = do
+ global <- BS.hGet h (BS.length archLF)
+ unless (global == archLF) $ wipeError "Bad global header"
+ wipeHeader (toInteger $ BS.length archLF)
+
+ where
+ wipeHeader :: Integer -> IO ()
+ wipeHeader offset = case compare offset archiveSize of
+ EQ -> return ()
+ GT -> wipeError (atOffset "Archive truncated")
+ LT -> do
+ header <- BS.hGet h headerSize
+ unless (BS.length header == headerSize) $
+ wipeError (atOffset "Short header")
+ let magic = BS.drop 58 header
+ unless (magic == x60LF) . wipeError . atOffset $
+ "Bad magic " ++ show magic ++ " in header"
+
+ let name = BS.take 16 header
+ let size = BS.take 10 $ BS.drop 48 header
+ objSize <- case reads (BS8.unpack size) of
+ [(n, s)] | all isSpace s -> return n
+ _ -> wipeError (atOffset "Bad file size in header")
+
+ let replacement = BS.concat [ name, metadata, size, magic ]
+ unless (BS.length replacement == headerSize) $
+ wipeError (atOffset "Something has gone terribly wrong")
+ hSeek h AbsoluteSeek offset
+ BS.hPut h replacement
+
+ let nextHeader = offset + toInteger headerSize +
+ -- Odd objects are padded with an extra '\x0a'
+ if odd objSize then objSize + 1 else objSize
+ hSeek h AbsoluteSeek nextHeader
+ wipeHeader nextHeader
+
+ where
+ atOffset msg = msg ++ " at offset " ++ show offset
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
@@ -12,7 +12,7 @@
--
module Distribution.Simple.Program.Builtin (
- -- * The collection of unconfigured and configured progams
+ -- * The collection of unconfigured and configured programs
builtinPrograms,
-- * Programs that Cabal knows about
@@ -25,9 +25,10 @@
jhcProgram,
hugsProgram,
ffihugsProgram,
+ haskellSuiteProgram,
+ haskellSuitePkgProgram,
uhcProgram,
gccProgram,
- ranlibProgram,
arProgram,
stripProgram,
happyProgram,
@@ -66,6 +67,8 @@
, ghcPkgProgram
, hugsProgram
, ffihugsProgram
+ , haskellSuiteProgram
+ , haskellSuitePkgProgram
, nhcProgram
, hmakeProgram
, jhcProgram
@@ -84,7 +87,6 @@
, greencardProgram
-- platform toolchain
, gccProgram
- , ranlibProgram
, arProgram
, stripProgram
, ldProgram
@@ -175,6 +177,39 @@
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,
+-- so this is the best we can do.)
+--
+-- Having this Program value serves two purposes:
+--
+-- 1. We can accept options for the compiler in the form of
+--
+-- --haskell-suite-option(s)=...
+--
+-- 2. We can find a program later using this static id (with
+-- requireProgram).
+--
+-- The path to the real compiler is found and recorded in the ProgramDb
+-- during the configure phase.
+haskellSuiteProgram :: Program
+haskellSuiteProgram = (simpleProgram "haskell-suite") {
+ -- pretend that the program exists, otherwise it won't be in the
+ -- "configured" state
+ programFindLocation =
+ \_verbosity _searchPath -> return $ Just "haskell-suite-dummy-location"
+ }
+
+-- This represent a haskell-suite package manager. See the comments for
+-- haskellSuiteProgram.
+haskellSuitePkgProgram :: Program
+haskellSuitePkgProgram = (simpleProgram "haskell-suite-pkg") {
+ programFindLocation =
+ \_verbosity _searchPath -> return $ Just "haskell-suite-pkg-dummy-location"
+ }
+
+
happyProgram :: Program
happyProgram = (simpleProgram "happy") {
programFindVersion = findProgramVersion "--version" $ \str ->
@@ -199,9 +234,6 @@
gccProgram = (simpleProgram "gcc") {
programFindVersion = findProgramVersion "-dumpversion" id
}
-
-ranlibProgram :: Program
-ranlibProgram = simpleProgram "ranlib"
arProgram :: Program
arProgram = simpleProgram "ar"
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
@@ -42,6 +42,7 @@
userSpecifiedArgs,
lookupProgram,
updateProgram,
+ configuredPrograms,
-- ** Query and manipulate the program db
configureProgram,
@@ -60,7 +61,7 @@
import Distribution.Simple.Program.Builtin
( builtinPrograms )
import Distribution.Simple.Utils
- ( die )
+ ( die, doesExecutableExist )
import Distribution.Version
( Version, VersionRange, isAnyVersion, withinRange )
import Distribution.Text
@@ -75,10 +76,7 @@
import qualified Data.Map as Map
import Control.Monad
( join, foldM )
-import System.Directory
- ( doesFileExist )
-
-- ------------------------------------------------------------
-- * Programs database
-- ------------------------------------------------------------
@@ -173,7 +171,7 @@
-- | Get the current 'ProgramSearchPath' used by the 'ProgramDb'.
-- This is the default list of locations where programs are looked for when
--- configuring them. This can be overriden for specific programs (with
+-- configuring them. This can be overridden for specific programs (with
-- 'userSpecifyPath'), and specific known programs can modify or ignore this
-- search path in their own configuration code.
--
@@ -268,12 +266,16 @@
Map.insert (programId prog) prog
+-- | List all configured programs.
+configuredPrograms :: ProgramDb -> [ConfiguredProgram]
+configuredPrograms = Map.elems . configuredProgs
+
-- ---------------------------
-- Configuring known programs
-- | Try to configure a specific program. If the program is already included in
--- the colleciton of unconfigured programs then we use any user-supplied
--- location and arguments. If the program gets configured sucessfully it gets
+-- the collection of unconfigured programs then we use any user-supplied
+-- location and arguments. If the program gets configured successfully it gets
-- added to the configured collection.
--
-- Note that it is not a failure if the program cannot be configured. It's only
@@ -295,13 +297,15 @@
Nothing -> programFindLocation prog verbosity (progSearchPath conf)
>>= return . fmap FoundOnSystem
Just path -> do
- absolute <- doesFileExist path
+ absolute <- doesExecutableExist path
if absolute
then return (Just (UserSpecified path))
else findProgramOnSearchPath verbosity (progSearchPath conf) path
>>= maybe (die notFound) (return . Just . UserSpecified)
- where notFound = "Cannot find the program '" ++ name ++ "' at '"
- ++ path ++ "' or on the path"
+ where notFound = "Cannot find the program '" ++ name
+ ++ "'. User-specified path '"
+ ++ path ++ "' does not refer to an executable and "
+ ++ "the program is not on the system path."
case maybeLocation of
Nothing -> return conf
Just location -> do
@@ -379,8 +383,8 @@
Nothing -> die notFound
Just configuredProg -> return (configuredProg, conf')
- where notFound = "The program " ++ programName prog
- ++ " is required but it could not be found."
+ where notFound = "The program '" ++ programName prog
+ ++ "' is required but it could not be found."
-- | Check that a program is configured and available to be run.
@@ -412,15 +416,15 @@
| otherwise -> die (badVersion version location)
Nothing -> die (noVersion location)
- where notFound = "The program "
- ++ programName prog ++ versionRequirement
+ where notFound = "The program '"
+ ++ programName prog ++ "'" ++ versionRequirement
++ " is required but it could not be found."
- badVersion v l = "The program "
- ++ programName prog ++ versionRequirement
+ badVersion v l = "The program '"
+ ++ programName prog ++ "'" ++ versionRequirement
++ " is required but the version found at "
++ locationPath l ++ " is version " ++ display v
- noVersion l = "The program "
- ++ programName prog ++ versionRequirement
+ noVersion l = "The program '"
+ ++ programName prog ++ "'" ++ versionRequirement
++ " is required but the version of "
++ locationPath l ++ " could not be determined."
versionRequirement
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
@@ -31,11 +31,11 @@
import Distribution.Verbosity
( Verbosity )
import Distribution.Simple.Utils
- ( debug )
+ ( debug, doesExecutableExist )
import Distribution.System
( OS(..), buildOS )
import System.Directory
- ( findExecutable, doesFileExist, Permissions(..), getPermissions )
+ ( findExecutable )
import Distribution.Compat.Environment
( getEnvironment )
import System.FilePath
@@ -91,19 +91,25 @@
Windows -> ["", "exe"]
_ -> [""]
- tryPathElem ProgramSearchPathDefault =
- findExecutable prog
+ tryPathElem ProgramSearchPathDefault = do
+ -- 'findExecutable' doesn't check that the path really refers to an
+ -- executable on Windows (at least with GHC < 7.8). See
+ -- https://ghc.haskell.org/trac/ghc/ticket/2184
+ mExe <- findExecutable prog
+ case mExe of
+ Just exe -> do
+ exeExists <- doesExecutableExist exe
+ if exeExists
+ then return mExe
+ else return Nothing
+ _ -> return mExe
findFirstExe [] = return Nothing
findFirstExe (f:fs) = do
- exists <- doesFileExist f
- if exists
- then do perms <- getPermissions f
- if executable perms
- then return (Just f)
- else findFirstExe fs
+ isExe <- doesExecutableExist f
+ if isExe
+ then return (Just f)
else findFirstExe fs
-
-- | Interpret a 'ProgramSearchPath' to construct a new @$PATH@ env var.
-- Note that this is close but not perfect because on Windows the search
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
@@ -14,18 +14,18 @@
import Distribution.Package
import Distribution.ModuleName
import Distribution.Simple.Compiler hiding (Flag)
-import Distribution.Simple.Setup (Flag(..), flagToMaybe, fromFlagOrDefault, flagToList)
+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 Language.Haskell.Extension ( Language(..), Extension(..) )
+import Language.Haskell.Extension ( Language(..), Extension(..) )
import Data.Monoid
-
-- | A structured set of GHC options/flags
--
data GhcOptions = GhcOptions {
@@ -148,6 +148,9 @@
-- | Use the \"split object files\" feature; the @ghc -split-objs@ flag.
ghcOptSplitObjs :: Flag Bool,
+ -- | Run N jobs simultaneously (if possible).
+ ghcOptNumJobs :: Flag Int,
+
----------------
-- GHCi
@@ -208,20 +211,22 @@
deriving (Show, Eq)
-runGHC :: Verbosity -> ConfiguredProgram -> GhcOptions -> IO ()
-runGHC verbosity ghcProg opts = do
- runProgramInvocation verbosity (ghcInvocation ghcProg opts)
+runGHC :: Verbosity -> ConfiguredProgram -> Compiler -> GhcOptions -> IO ()
+runGHC verbosity ghcProg comp opts = do
+ runProgramInvocation verbosity (ghcInvocation ghcProg comp opts)
-ghcInvocation :: ConfiguredProgram -> GhcOptions -> ProgramInvocation
-ghcInvocation ConfiguredProgram { programVersion = Nothing } _ =
- error "ghcInvocation: the programVersion must not be Nothing"
-ghcInvocation prog@ConfiguredProgram { programVersion = Just ver } opts =
- programInvocation prog (renderGhcOptions ver opts)
+ghcInvocation :: ConfiguredProgram -> Compiler -> GhcOptions -> ProgramInvocation
+ghcInvocation prog comp opts =
+ programInvocation prog (renderGhcOptions comp opts)
-renderGhcOptions :: Version -> GhcOptions -> [String]
-renderGhcOptions version@(Version ver _) opts =
+renderGhcOptions :: Compiler -> GhcOptions -> [String]
+renderGhcOptions comp opts
+ | compilerFlavor comp /= GHC =
+ error $ "Distribution.Simple.Program.GHC.renderGhcOptions: "
+ ++ "compiler flavor must be 'GHC'!"
+ | otherwise =
concat
[ case flagToMaybe (ghcOptMode opts) of
Nothing -> []
@@ -258,6 +263,13 @@
, [ "-split-objs" | flagBool ghcOptSplitObjs ]
+
+ , if parmakeSupported comp
+ then
+ let numJobs = fromFlagOrDefault 1 (ghcOptNumJobs opts)
+ in if numJobs > 1 then ["-j" ++ show numJobs] else []
+ else []
+
--------------------
-- Dynamic linking
@@ -330,8 +342,8 @@
, [ case lookup ext (ghcOptExtensionMap opts) of
Just arg -> arg
- Nothing -> error $ "renderGhcOptions: " ++ display ext
- ++ " not present in ghcOptExtensionMap."
+ Nothing -> error $ "Distribution.Simple.Program.GHC.renderGhcOptions: "
+ ++ display ext ++ " not present in ghcOptExtensionMap."
| ext <- ghcOptExtensions opts ]
----------------
@@ -362,6 +374,7 @@
flags flg = flg opts
flagBool flg = fromFlagOrDefault False (flg opts)
+ version@(Version ver _) = compilerVersion comp
verbosityOpts :: Verbosity -> [String]
verbosityOpts verbosity
@@ -425,6 +438,7 @@
ghcOptOptimisation = mempty,
ghcOptProfilingMode = mempty,
ghcOptSplitObjs = mempty,
+ ghcOptNumJobs = mempty,
ghcOptGHCiScripts = mempty,
ghcOptHiSuffix = mempty,
ghcOptObjSuffix = mempty,
@@ -473,6 +487,7 @@
ghcOptOptimisation = combine ghcOptOptimisation,
ghcOptProfilingMode = combine ghcOptProfilingMode,
ghcOptSplitObjs = combine ghcOptSplitObjs,
+ ghcOptNumJobs = combine ghcOptNumJobs,
ghcOptGHCiScripts = combine ghcOptGHCiScripts,
ghcOptHiSuffix = combine ghcOptHiSuffix,
ghcOptObjSuffix = combine ghcOptObjSuffix,
diff --git a/Distribution/Simple/Program/Strip.hs b/Distribution/Simple/Program/Strip.hs
new file mode 100644
--- /dev/null
+++ b/Distribution/Simple/Program/Strip.hs
@@ -0,0 +1,58 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Distribution.Simple.Program.Strip
+--
+-- Maintainer : cabal-devel@haskell.org
+-- Portability : portable
+--
+-- This module provides an library interface to the @strip@ program.
+
+module Distribution.Simple.Program.Strip (stripLib, stripExe)
+ where
+
+import Distribution.Simple.Program (ProgramConfiguration, lookupProgram
+ ,rawSystemProgram, stripProgram)
+import Distribution.Simple.Utils (warn)
+import Distribution.System (Platform(..), OS (..), buildOS)
+import Distribution.Verbosity (Verbosity)
+
+import Control.Monad (unless)
+import System.FilePath (takeBaseName)
+
+runStrip :: Verbosity -> ProgramConfiguration -> FilePath -> [String] -> IO ()
+runStrip verbosity progConf path args =
+ case lookupProgram stripProgram progConf of
+ Just strip -> rawSystemProgram verbosity strip (path:args)
+ Nothing -> unless (buildOS == Windows) $
+ -- Don't bother warning on windows, we don't expect them to
+ -- have the strip program anyway.
+ warn verbosity $ "Unable to strip executable or library '"
+ ++ (takeBaseName path)
+ ++ "' (missing the 'strip' program)"
+
+stripExe :: Verbosity -> Platform -> ProgramConfiguration -> FilePath -> IO ()
+stripExe verbosity (Platform _arch os) conf path =
+ runStrip verbosity conf path args
+ where
+ args = case os of
+ OSX -> ["-x"] -- By default, stripping the ghc binary on at least
+ -- some OS X installations causes:
+ -- HSbase-3.0.o: unknown symbol `_environ'"
+ -- The -x flag fixes that.
+ _ -> []
+
+stripLib :: Verbosity -> Platform -> ProgramConfiguration -> FilePath -> IO ()
+stripLib verbosity (Platform _arch os) conf path = do
+ case os of
+ OSX -> -- '--strip-unneeded' is not supported on OS X, iOS or
+ -- Solaris. See #1630.
+ return ()
+ IOS -> return ()
+ Solaris -> return ()
+ Windows -> -- Stripping triggers a bug in 'strip.exe' for
+ -- libraries with lots identically named modules. See
+ -- #1784.
+ return()
+ _ -> runStrip verbosity conf path args
+ where
+ args = ["--strip-unneeded"]
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
@@ -57,7 +57,7 @@
-> IO (Maybe FilePath),
-- | Try to find the version of the program. For many programs this is
- -- not possible or is not necessary so it's ok to return Nothing.
+ -- not possible or is not necessary so it's OK to return Nothing.
programFindVersion :: Verbosity -> FilePath -> IO (Maybe Version),
-- | A function to do any additional configuration after we have
@@ -100,7 +100,7 @@
programLocation :: ProgramLocation
} deriving (Read, Show, Eq)
--- | Where a program was found. Also tells us whether it's specifed by user or
+-- | 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
= UserSpecified { locationPath :: FilePath }
diff --git a/Distribution/Simple/Register.hs b/Distribution/Simple/Register.hs
--- a/Distribution/Simple/Register.hs
+++ b/Distribution/Simple/Register.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.Register
-- Copyright : Isaac Jones 2003-2004
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -14,7 +15,7 @@
-- popular so we also provide a way to simply generate the package registration
-- file which then must be manually passed to @ghc-pkg@. It is possible to
-- generate registration information for where the package is to be installed,
--- or alternatively to register the package inplace in the build tree. The
+-- or alternatively to register the package in place in the build tree. The
-- latter is occasionally handy, and will become more important when we try to
-- build multi-package systems.
--
@@ -22,37 +23,6 @@
-- mixes it all in in this module, which is rather unsatisfactory. The script
-- generation and the unregister feature are not well used or tested.
-{- Copyright (c) 2003-2004, Isaac Jones
-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 Isaac Jones 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. -}
-
module Distribution.Simple.Register (
register,
unregister,
@@ -76,6 +46,7 @@
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.HaskellSuite as HaskellSuite
import Distribution.Simple.Compiler
( compilerVersion, Compiler, CompilerFlavor(..), compilerFlavor
, PackageDBStack, registrationPackageDB )
@@ -214,6 +185,7 @@
initPackageDB verbosity comp conf dbPath =
case (compilerFlavor comp) of
GHC -> GHC.initPackageDB verbosity conf dbPath
+ HaskellSuite {} -> HaskellSuite.initPackageDB verbosity conf dbPath
_ -> die "Distribution.Simple.Register.initPackageDB: \
\not implemented for this compiler"
@@ -246,6 +218,8 @@
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)"
+ HaskellSuite {} ->
+ HaskellSuite.registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs
_ -> die "Registering is not implemented for this compiler"
@@ -332,10 +306,10 @@
hasLibrary = hasModules || not (null (cSources bi))
--- | Construct 'InstalledPackageInfo' for a library that is inplace in the
+-- | Construct 'InstalledPackageInfo' for a library that is in place in the
-- build tree.
--
--- This function knows about the layout of inplace packages.
+-- This function knows about the layout of in place packages.
--
inplaceInstalledPackageInfo :: FilePath -- ^ top of the build tree
-> FilePath -- ^ location of the dist tree
diff --git a/Distribution/Simple/Setup.hs b/Distribution/Simple/Setup.hs
--- a/Distribution/Simple/Setup.hs
+++ b/Distribution/Simple/Setup.hs
@@ -3,6 +3,7 @@
-- Module : Distribution.Simple.Setup
-- Copyright : Isaac Jones 2003-2004
-- Duncan Coutts 2007
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -26,43 +27,13 @@
-- read and written from files. This would allow us to save configure flags in
-- config files.
-{- 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 Isaac Jones 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. -}
-
{-# LANGUAGE CPP #-}
module Distribution.Simple.Setup (
GlobalFlags(..), emptyGlobalFlags, defaultGlobalFlags, globalCommand,
ConfigFlags(..), emptyConfigFlags, defaultConfigFlags, configureCommand,
- configAbsolutePaths,
+ configAbsolutePaths, readPackageDbList, showPackageDbList,
CopyFlags(..), emptyCopyFlags, defaultCopyFlags, copyCommand,
InstallFlags(..), emptyInstallFlags, defaultInstallFlags, installCommand,
HaddockFlags(..), emptyHaddockFlags, defaultHaddockFlags, haddockCommand,
@@ -80,7 +51,7 @@
defaultBenchmarkFlags, benchmarkCommand,
CopyDest(..),
configureArgs, configureOptions, configureCCompiler, configureLinker,
- buildOptions, installDirsOptions,
+ buildOptions, haddockOptions, installDirsOptions,
programConfigurationOptions, programConfigurationPaths',
defaultDistPref,
@@ -91,7 +62,7 @@
fromFlagOrDefault,
flagToMaybe,
flagToList,
- boolOpt, boolOpt', trueArg, falseArg, optionVerbosity ) where
+ boolOpt, boolOpt', trueArg, falseArg, optionVerbosity, optionNumJobs ) where
import Distribution.Compiler ()
import Distribution.ReadE
@@ -99,7 +70,9 @@
( Text(..), display )
import qualified Distribution.Compat.ReadP as Parse
import qualified Text.PrettyPrint as Disp
-import Distribution.Package ( Dependency(..) )
+import Distribution.Package ( Dependency(..)
+ , PackageName
+ , InstalledPackageId )
import Distribution.PackageDescription
( FlagName(..), FlagAssignment )
import Distribution.Simple.Command hiding (boolOpt, boolOpt')
@@ -160,7 +133,7 @@
instance Monoid (Flag a) where
mempty = NoFlag
_ `mappend` f@(Flag _) = f
- f `mappend` NoFlag = f
+ f `mappend` NoFlag = f
instance Bounded a => Bounded (Flag a) where
minBound = toFlag minBound
@@ -198,7 +171,9 @@
flagToList NoFlag = []
allFlags :: [Flag Bool] -> Flag Bool
-allFlags flags = toFlag $ all (\f -> fromFlagOrDefault False f) flags
+allFlags flags = if all (\f -> fromFlagOrDefault False f) flags
+ then Flag True
+ else NoFlag
-- ------------------------------------------------------------
-- * Global flags
@@ -275,11 +250,11 @@
configPrograms :: ProgramConfiguration, -- ^All programs that cabal may
-- run
- configProgramPaths :: [(String, FilePath)], -- ^user specifed programs paths
- configProgramArgs :: [(String, [String])], -- ^user specifed programs args
+ configProgramPaths :: [(String, FilePath)], -- ^user specified programs paths
+ configProgramArgs :: [(String, [String])], -- ^user specified programs args
configProgramPathExtra :: [FilePath], -- ^Extend the $PATH
configHcFlavor :: Flag CompilerFlavor, -- ^The \"flavor\" of the
- -- compiler, sugh as GHC or
+ -- compiler, such as GHC or
-- Hugs.
configHcPath :: Flag FilePath, -- ^given compiler location
configHcPkg :: Flag FilePath, -- ^given hc-pkg location
@@ -307,12 +282,19 @@
configGHCiLib :: Flag Bool, -- ^Enable compiling library for GHCi
configSplitObjs :: Flag Bool, -- ^Enable -split-objs with GHC
configStripExes :: Flag Bool, -- ^Enable executable stripping
+ configStripLibs :: Flag Bool, -- ^Enable library stripping
configConstraints :: [Dependency], -- ^Additional constraints for
- -- dependencies
+ -- dependencies.
+ configDependencies :: [(PackageName, InstalledPackageId)],
+ -- ^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
+ configTests :: Flag Bool, -- ^Enable test suite compilation
+ configBenchmarks :: Flag Bool, -- ^Enable benchmark compilation
+ configLibCoverage :: Flag Bool,
+ -- ^Enable test suite program coverage.
+ configExactConfiguration :: Flag Bool
+ -- ^All direct dependencies and flags are provided on the command line by
+ -- the user via the '--dependency' and '--flags' options.
}
deriving (Read,Show)
@@ -345,9 +327,11 @@
#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
+ configLibCoverage = Flag False,
+ configExactConfiguration = Flag False
}
configureCommand :: ProgramConfiguration -> CommandUI ConfigFlags
@@ -382,8 +366,13 @@
, (Flag JHC, ([] , ["jhc"]), "compile with JHC")
, (Flag LHC, ([] , ["lhc"]), "compile with LHC")
, (Flag Hugs,([] , ["hugs"]), "compile with Hugs")
- , (Flag UHC, ([] , ["uhc"]), "compile with UHC")])
+ , (Flag UHC, ([] , ["uhc"]), "compile with UHC")
+ -- "haskell-suite" compiler id string will be replaced
+ -- by a more specific one during the configure stage
+ , (Flag (HaskellSuite "haskell-suite"), ([] , ["haskell-suite"]),
+ "compile with a haskell-suite compiler")])
+
,option "w" ["with-compiler"]
"give the path to a particular compiler"
configHcPath (\v flags -> flags { configHcPath = v })
@@ -467,6 +456,11 @@
configStripExes (\v flags -> flags { configStripExes = v })
(boolOpt [] [])
+ ,option "" ["library-stripping"]
+ "strip libraries upon installation to reduce binary sizes"
+ configStripLibs (\v flags -> flags { configStripLibs = v })
+ (boolOpt [] [])
+
,option "" ["configure-option"]
"Extra option for configure"
configConfigureArgs (\v flags -> flags { configConfigureArgs = v })
@@ -508,14 +502,30 @@
(reqArg "DEPENDENCY"
(readP_to_E (const "dependency expected") ((\x -> [x]) `fmap` parse))
(map (\x -> display x)))
+
+ ,option "" ["dependency"]
+ "A list of exact dependencies. E.g., --dependency=\"void=void-0.5.8-177d5cdf20962d0581fe2e4932a6c309\""
+ configDependencies (\v flags -> flags { configDependencies = v})
+ (reqArg "NAME=ID"
+ (readP_to_E (const "dependency expected") ((\x -> [x]) `fmap` parseDependency))
+ (map (\x -> display (fst x) ++ "=" ++ display (snd x))))
+
,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)"
configLibCoverage (\v flags -> flags { configLibCoverage = v })
(boolOpt [] [])
+
+ ,option "" ["exact-configuration"]
+ "All direct dependencies and flags are provided on the command line."
+ configExactConfiguration
+ (\v flags -> flags { configExactConfiguration = v })
+ trueArg
+
,option "" ["benchmarks"]
"dependency checking and compilation for benchmarks listed in the package description file."
configBenchmarks (\v flags -> flags { configBenchmarks = v })
@@ -531,20 +541,6 @@
showFlagList fs = [ if not set then '-':fname else fname
| (FlagName fname, set) <- fs]
- readPackageDbList :: String -> [Maybe PackageDB]
- readPackageDbList "clear" = [Nothing]
- readPackageDbList "global" = [Just GlobalPackageDB]
- readPackageDbList "user" = [Just UserPackageDB]
- readPackageDbList other = [Just (SpecificPackageDB other)]
-
- showPackageDbList :: [Maybe PackageDB] -> [String]
- showPackageDbList = map showPackageDb
- where
- showPackageDb Nothing = "clear"
- showPackageDb (Just GlobalPackageDB) = "global"
- showPackageDb (Just UserPackageDB) = "user"
- showPackageDb (Just (SpecificPackageDB db)) = db
-
liftInstallDirs =
liftOption configInstallDirs (\v flags -> flags { configInstallDirs = v })
@@ -552,6 +548,28 @@
reqArgFlag title _sf _lf d
(fmap fromPathTemplate . get) (set . fmap toPathTemplate)
+readPackageDbList :: String -> [Maybe PackageDB]
+readPackageDbList "clear" = [Nothing]
+readPackageDbList "global" = [Just GlobalPackageDB]
+readPackageDbList "user" = [Just UserPackageDB]
+readPackageDbList other = [Just (SpecificPackageDB other)]
+
+showPackageDbList :: [Maybe PackageDB] -> [String]
+showPackageDbList = map showPackageDb
+ where
+ showPackageDb Nothing = "clear"
+ showPackageDb (Just GlobalPackageDB) = "global"
+ showPackageDb (Just UserPackageDB) = "user"
+ showPackageDb (Just (SpecificPackageDB db)) = db
+
+
+parseDependency :: Parse.ReadP r (PackageName, InstalledPackageId)
+parseDependency = do
+ x <- parse
+ _ <- Parse.char '='
+ y <- parse
+ return (x, y)
+
installDirsOptions :: [OptionField (InstallDirs (Flag PathTemplate))]
installDirsOptions =
[ option "" ["prefix"]
@@ -644,13 +662,16 @@
configGHCiLib = mempty,
configSplitObjs = mempty,
configStripExes = mempty,
+ configStripLibs = mempty,
configExtraLibDirs = mempty,
configConstraints = mempty,
+ configDependencies = mempty,
configExtraIncludeDirs = mempty,
configConfigurationsFlags = mempty,
- configTests = mempty,
- configLibCoverage = mempty,
- configBenchmarks = mempty
+ configTests = mempty,
+ configLibCoverage = mempty,
+ configExactConfiguration = mempty,
+ configBenchmarks = mempty
}
mappend a b = ConfigFlags {
configPrograms = configPrograms b,
@@ -678,13 +699,16 @@
configGHCiLib = combine configGHCiLib,
configSplitObjs = combine configSplitObjs,
configStripExes = combine configStripExes,
+ configStripLibs = combine configStripLibs,
configExtraLibDirs = combine configExtraLibDirs,
configConstraints = combine configConstraints,
+ configDependencies = combine configDependencies,
configExtraIncludeDirs = combine configExtraIncludeDirs,
configConfigurationsFlags = combine configConfigurationsFlags,
- configTests = combine configTests,
- configLibCoverage = combine configLibCoverage,
- configBenchmarks = combine configBenchmarks
+ configTests = combine configTests,
+ configLibCoverage = combine configLibCoverage,
+ configExactConfiguration = combine configExactConfiguration,
+ configBenchmarks = combine configBenchmarks
}
where combine field = field a `mappend` field b
@@ -1143,95 +1167,98 @@
where
name = "haddock"
shortDesc = "Generate Haddock HTML documentation."
- longDesc = Just $ \_ -> "Requires the program haddock, version 2.x.\n"
- options showOrParseArgs =
- [optionVerbosity haddockVerbosity
- (\v flags -> flags { haddockVerbosity = v })
- ,optionDistPref
- haddockDistPref (\d flags -> flags { haddockDistPref = d })
- showOrParseArgs
+ longDesc = Just $ \_ -> "Requires the program haddock, either version 0.x or 2.x.\n"
+ options 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})
+ progConf = addKnownProgram haddockProgram
+ $ addKnownProgram ghcProgram
+ $ emptyProgramConfiguration
- ,option "" ["keep-temp-files"]
- "Keep temporary files"
- haddockKeepTempFiles (\b flags -> flags { haddockKeepTempFiles = b })
- trueArg
+haddockOptions :: ShowOrParseArgs -> [OptionField HaddockFlags]
+haddockOptions showOrParseArgs =
+ [optionVerbosity haddockVerbosity
+ (\v flags -> flags { haddockVerbosity = v })
+ ,optionDistPref
+ haddockDistPref (\d flags -> flags { haddockDistPref = d })
+ showOrParseArgs
- ,option "" ["hoogle"]
- "Generate a hoogle database"
- haddockHoogle (\v flags -> flags { haddockHoogle = v })
- trueArg
+ ,option "" ["keep-temp-files"]
+ "Keep temporary files"
+ haddockKeepTempFiles (\b flags -> flags { haddockKeepTempFiles = b })
+ trueArg
- ,option "" ["html"]
- "Generate HTML documentation (the default)"
- haddockHtml (\v flags -> flags { haddockHtml = v })
- trueArg
+ ,option "" ["hoogle"]
+ "Generate a hoogle database"
+ haddockHoogle (\v flags -> flags { haddockHoogle = v })
+ trueArg
- ,option "" ["html-location"]
- "Location of HTML documentation for pre-requisite packages"
- haddockHtmlLocation (\v flags -> flags { haddockHtmlLocation = v })
- (reqArgFlag "URL")
+ ,option "" ["html"]
+ "Generate HTML documentation (the default)"
+ haddockHtml (\v flags -> flags { haddockHtml = v })
+ trueArg
- ,option "" ["executables"]
- "Run haddock for Executables targets"
- haddockExecutables (\v flags -> flags { haddockExecutables = v })
- trueArg
+ ,option "" ["html-location"]
+ "Location of HTML documentation for pre-requisite packages"
+ haddockHtmlLocation (\v flags -> flags { haddockHtmlLocation = v })
+ (reqArgFlag "URL")
- ,option "" ["tests"]
- "Run haddock for Test Suite targets"
- haddockTestSuites (\v flags -> flags { haddockTestSuites = v })
- trueArg
+ ,option "" ["executables"]
+ "Run haddock for Executables targets"
+ haddockExecutables (\v flags -> flags { haddockExecutables = v })
+ trueArg
- ,option "" ["benchmarks"]
- "Run haddock for Benchmark targets"
- haddockBenchmarks (\v flags -> flags { haddockBenchmarks = v })
- trueArg
+ ,option "" ["tests"]
+ "Run haddock for Test Suite targets"
+ haddockTestSuites (\v flags -> flags { haddockTestSuites = v })
+ trueArg
- ,option "" ["all"]
- "Run haddock for all targets"
- (\f -> allFlags [ haddockExecutables f
- , haddockTestSuites f
- , haddockBenchmarks f])
+ ,option "" ["benchmarks"]
+ "Run haddock for Benchmark targets"
+ haddockBenchmarks (\v flags -> flags { haddockBenchmarks = v })
+ trueArg
+
+ ,option "" ["all"]
+ "Run haddock for all targets"
+ (\f -> allFlags [ haddockExecutables f
+ , haddockTestSuites f
+ , haddockBenchmarks f])
(\v flags -> flags { haddockExecutables = v
, haddockTestSuites = v
, haddockBenchmarks = v })
trueArg
- ,option "" ["internal"]
- "Run haddock for internal modules and include all symbols"
- haddockInternal (\v flags -> flags { haddockInternal = v })
- trueArg
+ ,option "" ["internal"]
+ "Run haddock for internal modules and include all symbols"
+ haddockInternal (\v flags -> flags { haddockInternal = v })
+ trueArg
- ,option "" ["css"]
- "Use PATH as the haddock stylesheet"
- haddockCss (\v flags -> flags { haddockCss = v })
- (reqArgFlag "PATH")
+ ,option "" ["css"]
+ "Use PATH as the haddock stylesheet"
+ haddockCss (\v flags -> flags { haddockCss = v })
+ (reqArgFlag "PATH")
- ,option "" ["hyperlink-source","hyperlink-sources"]
- "Hyperlink the documentation to the source code (using HsColour)"
- haddockHscolour (\v flags -> flags { haddockHscolour = v })
- trueArg
+ ,option "" ["hyperlink-source","hyperlink-sources"]
+ "Hyperlink the documentation to the source code (using HsColour)"
+ haddockHscolour (\v flags -> flags { haddockHscolour = v })
+ trueArg
- ,option "" ["hscolour-css"]
- "Use PATH as the HsColour stylesheet"
- haddockHscolourCss (\v flags -> flags { haddockHscolourCss = v })
- (reqArgFlag "PATH")
+ ,option "" ["hscolour-css"]
+ "Use PATH as the HsColour stylesheet"
+ haddockHscolourCss (\v flags -> flags { haddockHscolourCss = v })
+ (reqArgFlag "PATH")
- ,option "" ["contents-location"]
- "Bake URL in as the location for the contents page"
- haddockContents (\v flags -> flags { haddockContents = v })
- (reqArg' "URL"
- (toFlag . toPathTemplate)
- (flagToList . fmap fromPathTemplate))
- ]
- ++ 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})
- progConf = addKnownProgram haddockProgram
- $ addKnownProgram ghcProgram
- $ emptyProgramConfiguration
+ ,option "" ["contents-location"]
+ "Bake URL in as the location for the contents page"
+ haddockContents (\v flags -> flags { haddockContents = v })
+ (reqArg' "URL"
+ (toFlag . toPathTemplate)
+ (flagToList . fmap fromPathTemplate))
+ ]
emptyHaddockFlags :: HaddockFlags
emptyHaddockFlags = mempty
@@ -1336,6 +1363,7 @@
buildProgramArgs :: [(String, [String])],
buildDistPref :: Flag FilePath,
buildVerbosity :: Flag Verbosity,
+ buildNumJobs :: Flag (Maybe Int),
-- TODO: this one should not be here, it's just that the silly
-- UserHooks stop us from passing extra info in other ways
buildArgs :: [String]
@@ -1352,12 +1380,22 @@
buildProgramArgs = [],
buildDistPref = Flag defaultDistPref,
buildVerbosity = Flag normal,
+ buildNumJobs = mempty,
buildArgs = []
}
buildCommand :: ProgramConfiguration -> CommandUI BuildFlags
-buildCommand progConf = makeCommand name shortDesc longDesc
- defaultBuildFlags (buildOptions progConf)
+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."
@@ -1366,13 +1404,14 @@
++ " " ++ pname ++ " build "
++ " All the components in the package\n"
++ " " ++ pname ++ " build foo "
- ++ " A component (i.e. lib, exe, test suite)\n"
+ ++ " A component (i.e. lib, exe, test suite)\n\n"
+ ++ programFlagsDescription progConf
--TODO: re-enable once we have support for module/file targets
-- ++ " " ++ pname ++ " build Foo.Bar "
-- ++ " A module\n"
-- ++ " " ++ pname ++ " build Foo/Bar.hs"
-- ++ " A file\n\n"
--- ++ "If a target is ambigious it can be qualified with the component "
+-- ++ "If a target is ambiguous it can be qualified with the component "
-- ++ "name, e.g.\n"
-- ++ " " ++ pname ++ " build foo:Foo.Bar\n"
-- ++ " " ++ pname ++ " build testsuite1:Foo/Bar.hs\n"
@@ -1380,19 +1419,18 @@
buildOptions :: ProgramConfiguration -> ShowOrParseArgs
-> [OptionField BuildFlags]
buildOptions progConf showOrParseArgs =
- optionVerbosity buildVerbosity (\v flags -> flags { buildVerbosity = v })
- : optionDistPref
- buildDistPref (\d flags -> flags { buildDistPref = d })
- showOrParseArgs
+ [ optionNumJobs
+ buildNumJobs (\v flags -> flags { buildNumJobs = v })
+ ]
- : programConfigurationPaths progConf showOrParseArgs
- buildProgramPaths (\v flags -> flags { buildProgramPaths = v})
+ ++ programConfigurationPaths progConf showOrParseArgs
+ buildProgramPaths (\v flags -> flags { buildProgramPaths = v})
++ programConfigurationOption progConf showOrParseArgs
- buildProgramArgs (\v fs -> fs { buildProgramArgs = v })
+ buildProgramArgs (\v fs -> fs { buildProgramArgs = v })
++ programConfigurationOptions progConf showOrParseArgs
- buildProgramArgs (\v flags -> flags { buildProgramArgs = v})
+ buildProgramArgs (\v flags -> flags { buildProgramArgs = v})
emptyBuildFlags :: BuildFlags
emptyBuildFlags = mempty
@@ -1403,6 +1441,7 @@
buildProgramArgs = mempty,
buildVerbosity = mempty,
buildDistPref = mempty,
+ buildNumJobs = mempty,
buildArgs = mempty
}
mappend a b = BuildFlags {
@@ -1410,12 +1449,13 @@
buildProgramArgs = combine buildProgramArgs,
buildVerbosity = combine buildVerbosity,
buildDistPref = combine buildDistPref,
+ buildNumJobs = combine buildNumJobs,
buildArgs = combine buildArgs
}
where combine field = field a `mappend` field b
-- ------------------------------------------------------------
--- * Repl Flags
+-- * REPL Flags
-- ------------------------------------------------------------
data ReplFlags = ReplFlags {
@@ -1468,7 +1508,7 @@
-- ++ " A module\n"
-- ++ " " ++ pname ++ " repl Foo/Bar.hs"
-- ++ " A file\n\n"
--- ++ "If a target is ambigious it can be qualified with the component "
+-- ++ "If a target is ambiguous it can be qualified with the component "
-- ++ "name, e.g.\n"
-- ++ " " ++ pname ++ " repl foo:Foo.Bar\n"
-- ++ " " ++ pname ++ " repl testsuite1:Foo/Bar.hs\n"
@@ -1504,7 +1544,7 @@
-- * Test flags
-- ------------------------------------------------------------
-data TestShowDetails = Never | Failures | Always
+data TestShowDetails = Never | Failures | Always | Streaming
deriving (Eq, Ord, Enum, Bounded, Show)
knownTestShowDetails :: [TestShowDetails]
@@ -1800,10 +1840,9 @@
-> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
boolOpt' = Command.boolOpt' flagToMaybe Flag
-trueArg, falseArg :: SFlags -> LFlags -> Description -> (b -> Flag Bool) ->
- (Flag Bool -> (b -> b)) -> OptDescr b
-trueArg = noArg (Flag True)
-falseArg = noArg (Flag False)
+trueArg, falseArg :: MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
+trueArg sfT lfT = boolOpt' (sfT, lfT) ([], []) sfT lfT
+falseArg sfF lfF = boolOpt' ([], []) (sfF, lfF) sfF lfF
reqArgFlag :: ArgPlaceHolder -> SFlags -> LFlags -> Description ->
(b -> Flag String) -> (Flag String -> b -> b) -> OptDescr b
@@ -1833,6 +1872,28 @@
(optArg "n" (fmap Flag flagToVerbosity)
(Flag verbose) -- default Value if no n is given
(fmap (Just . showForCabal) . flagToList))
+
+optionNumJobs :: (flags -> Flag (Maybe Int))
+ -> (Flag (Maybe Int) -> flags -> flags)
+ -> OptionField flags
+optionNumJobs get set =
+ option "j" ["jobs"]
+ "Run NUM jobs simultaneously (or '$ncpus' if no NUM is given)."
+ get set
+ (optArg "NUM" (fmap Flag numJobsParser)
+ (Flag Nothing)
+ (map (Just . maybe "$ncpus" show) . flagToList))
+ where
+ numJobsParser :: ReadE (Maybe Int)
+ numJobsParser = ReadE $ \s ->
+ case s of
+ "$ncpus" -> Right Nothing
+ _ -> case reads s of
+ [(n, "")]
+ | n < 1 -> Left "The number of jobs should be 1 or more."
+ | n > 64 -> Left "You probably don't want that many jobs."
+ | otherwise -> Right (Just n)
+ _ -> Left "The jobs value should be a number or '$ncpus'"
-- ------------------------------------------------------------
-- * Other Utils
diff --git a/Distribution/Simple/SrcDist.hs b/Distribution/Simple/SrcDist.hs
--- a/Distribution/Simple/SrcDist.hs
+++ b/Distribution/Simple/SrcDist.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.SrcDist
-- Copyright : Simon Marlow 2004
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -16,37 +17,6 @@
-- it accepts the @-z@ flag. Neither of these assumptions are valid on Windows.
-- The 'sdist' action now also does some distribution QA checks.
-{- Copyright (c) 2003-2004, Simon Marlow
-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 Isaac Jones 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. -}
-
-- NOTE: FIX: we don't have a great way of testing this module, since
-- we can't easily look inside a tarball once its created.
@@ -59,7 +29,7 @@
prepareTree,
createArchive,
- -- ** Snaphots
+ -- ** Snapshots
prepareSnapshotTree,
snapshotPackage,
snapshotVersion,
@@ -254,10 +224,8 @@
. forM (extraDocFiles pkg_descr) $ \ filename ->
matchFileGlob filename
- -- License file.
- , return $ case [licenseFile pkg_descr]
- of [[]] -> []
- l -> l
+ -- License file(s).
+ , return (licenseFiles pkg_descr)
-- Install-include files.
, withLib $ \ l -> do
@@ -289,7 +257,7 @@
-> [PPSuffixHandler] -- ^extra preprocessors (includes suffixes)
-> IO ()
prepareTree verbosity pkg_descr0 mb_lbi targetDir pps = do
- -- If the package was configured then we can run platform independent
+ -- If the package was configured then we can run platform-independent
-- pre-processors and include those generated files.
case mb_lbi of
Just lbi | not (null pps) -> do
diff --git a/Distribution/Simple/Test.hs b/Distribution/Simple/Test.hs
--- a/Distribution/Simple/Test.hs
+++ b/Distribution/Simple/Test.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.Test
-- Copyright : Thomas Tuegel 2010
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -10,265 +11,35 @@
-- \"@.\/setup test@\" action. It runs test suites designated in the package
-- description and reports on the results.
-{- 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 Isaac Jones 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. -}
-
module Distribution.Simple.Test
( test
- , stubMain
- , writeSimpleTestStub
- , stubFilePath
- , stubName
- , PackageLog(..)
- , TestSuiteLog(..)
- , TestLogs(..)
- , suitePassed, suiteFailed, suiteError
) where
-import Distribution.Compat.TempFile ( openTempFile )
-import Distribution.ModuleName ( ModuleName )
-import Distribution.Package
- ( PackageId )
import qualified Distribution.PackageDescription as PD
( PackageDescription(..), BuildInfo(buildable)
, TestSuite(..)
, TestSuiteInterface(..), testType, hasTests )
-import Distribution.Simple.Build.PathsModule ( pkgPathEnvVar )
-import Distribution.Simple.BuildPaths ( exeExtension )
-import Distribution.Simple.Compiler ( Compiler(..), CompilerId )
-import Distribution.Simple.Hpc
- ( markupPackage, markupTest, tixDir, tixFilePath )
+import Distribution.Simple.Compiler ( Compiler(..) )
+import Distribution.Simple.Hpc ( markupPackage )
import Distribution.Simple.InstallDirs
- ( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..)
- , substPathTemplate , toPathTemplate, PathTemplate )
+ ( fromPathTemplate, initialPathTemplateEnv, substPathTemplate
+ , PathTemplate )
import qualified Distribution.Simple.LocalBuildInfo as LBI
( LocalBuildInfo(..) )
-import Distribution.Simple.Setup ( TestFlags(..), TestShowDetails(..), fromFlag )
-import Distribution.Simple.Utils ( die, notice, rawSystemIOWithEnv )
-import Distribution.TestSuite
- ( OptionDescr(..), Options, Progress(..), Result(..), TestInstance(..)
- , Test(..) )
+import Distribution.Simple.Setup ( TestFlags(..), fromFlag )
+import qualified Distribution.Simple.Test.ExeV10 as ExeV10
+import qualified Distribution.Simple.Test.LibV09 as LibV09
+import Distribution.Simple.Test.Log
+import Distribution.Simple.Utils ( die, notice )
+import Distribution.TestSuite ( Result(..) )
import Distribution.Text
-import Distribution.Verbosity ( normal, Verbosity )
-import Distribution.System ( Platform )
-import Control.Exception ( bracket )
import Control.Monad ( when, unless, filterM )
-import Data.Char ( toUpper )
-import Data.Maybe ( mapMaybe )
import System.Directory
- ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
- , getCurrentDirectory, getDirectoryContents, removeDirectoryRecursive
- , removeFile, setCurrentDirectory )
-import Distribution.Compat.Environment ( getEnvironment )
+ ( createDirectoryIfMissing, doesFileExist, getDirectoryContents
+ , removeFile )
import System.Exit ( ExitCode(..), exitFailure, exitWith )
-import System.FilePath ( (), (<.>) )
-import System.IO ( hClose, IOMode(..), openFile )
-
--- | Logs all test results for a package, broken down first by test suite and
--- then by test case.
-data PackageLog = PackageLog
- { package :: PackageId
- , compiler :: CompilerId
- , platform :: Platform
- , testSuites :: [TestSuiteLog]
- }
- deriving (Read, Show, Eq)
-
--- | A 'PackageLog' with package and platform information specified.
-localPackageLog :: PD.PackageDescription -> LBI.LocalBuildInfo -> PackageLog
-localPackageLog pkg_descr lbi = PackageLog
- { package = PD.package pkg_descr
- , compiler = compilerId $ LBI.compiler lbi
- , platform = LBI.hostPlatform lbi
- , testSuites = []
- }
-
--- | Logs test suite results, itemized by test case.
-data TestSuiteLog = TestSuiteLog
- { testSuiteName :: String
- , testLogs :: TestLogs
- , logFile :: FilePath -- path to human-readable log file
- }
- deriving (Read, Show, Eq)
-
-data TestLogs
- = TestLog
- { testName :: String
- , testOptionsReturned :: Options
- , testResult :: Result
- }
- | GroupLogs String [TestLogs]
- deriving (Read, Show, Eq)
-
--- | Count the number of pass, fail, and error test results in a 'TestLogs'
--- tree.
-countTestResults :: TestLogs
- -> (Int, Int, Int) -- ^ Passes, fails, and errors,
- -- respectively.
-countTestResults = go (0, 0, 0)
- where
- go (p, f, e) (TestLog { testResult = r }) =
- case r of
- Pass -> (p + 1, f, e)
- Fail _ -> (p, f + 1, e)
- Error _ -> (p, f, e + 1)
- go (p, f, e) (GroupLogs _ ts) = foldl go (p, f, e) ts
-
--- | From a 'TestSuiteLog', determine if the test suite passed.
-suitePassed :: TestSuiteLog -> Bool
-suitePassed l =
- case countTestResults (testLogs l) of
- (_, 0, 0) -> True
- _ -> False
-
--- | From a 'TestSuiteLog', determine if the test suite failed.
-suiteFailed :: TestSuiteLog -> Bool
-suiteFailed l =
- case countTestResults (testLogs l) of
- (_, 0, _) -> False
- _ -> True
-
--- | From a 'TestSuiteLog', determine if the test suite encountered errors.
-suiteError :: TestSuiteLog -> Bool
-suiteError l =
- case countTestResults (testLogs l) of
- (_, _, 0) -> False
- _ -> True
-
--- | Run a test executable, logging the output and generating the appropriate
--- summary messages.
-testController :: TestFlags
- -- ^ flags Cabal was invoked with
- -> PD.PackageDescription
- -- ^ description of package the test suite belongs to
- -> LBI.LocalBuildInfo
- -- ^ information from the configure step
- -> PD.TestSuite
- -- ^ TestSuite being tested
- -> (FilePath -> String)
- -- ^ prepare standard input for test executable
- -> FilePath -- ^ executable name
- -> (ExitCode -> String -> TestSuiteLog)
- -- ^ generator for the TestSuiteLog
- -> (TestSuiteLog -> FilePath)
- -- ^ generator for final human-readable log filename
- -> IO TestSuiteLog
-testController flags pkg_descr lbi suite preTest cmd postTest logNamer = do
- let distPref = fromFlag $ testDistPref flags
- verbosity = fromFlag $ testVerbosity flags
- testLogDir = distPref "test"
- opts = map (testOption pkg_descr lbi suite) $ testOptions flags
-
- pwd <- getCurrentDirectory
- existingEnv <- getEnvironment
- let dataDirPath = pwd PD.dataDir pkg_descr
- shellEnv = (pkgPathEnvVar pkg_descr "datadir", dataDirPath)
- : ("HPCTIXFILE", () pwd
- $ tixFilePath distPref $ PD.testName suite)
- : existingEnv
-
- bracket (openCabalTemp testLogDir) deleteIfExists $ \tempLog ->
- bracket (openCabalTemp testLogDir) deleteIfExists $ \tempInput -> do
-
- -- Check that the test executable exists.
- exists <- doesFileExist cmd
- unless exists $ die $ "Error: Could not find test program \"" ++ cmd
- ++ "\". Did you build the package first?"
-
- -- 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
-
- -- Create directory for HPC files.
- createDirectoryIfMissing True $ tixDir distPref $ PD.testName suite
-
- -- Write summary notices indicating start of test suite
- notice verbosity $ summarizeSuiteStart $ PD.testName suite
-
- -- Prepare standard input for test executable
- appendFile tempInput $ preTest tempInput
-
- -- Run test executable
- exit <- do
- hLog <- openFile tempLog AppendMode
- hIn <- openFile tempInput ReadMode
- -- these handles get closed by rawSystemIOWithEnv
- rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv)
- (Just hIn) (Just hLog) (Just hLog)
-
- -- Generate TestSuiteLog from executable exit code and a machine-
- -- readable test log
- suiteLog <- fmap (postTest exit $!) $ readFile tempInput
-
- -- Generate final log file name
- let finalLogName = testLogDir logNamer suiteLog
- suiteLog' = suiteLog { logFile = finalLogName }
-
- -- Write summary notice to log file indicating start of test suite
- appendFile (logFile suiteLog') $ summarizeSuiteStart $ PD.testName suite
-
- -- Append contents of temporary log file to the final human-
- -- readable log file
- readFile tempLog >>= appendFile (logFile suiteLog')
-
- -- Write end-of-suite summary notice to log file
- appendFile (logFile suiteLog') $ summarizeSuiteFinish suiteLog'
-
- -- Show the contents of the human-readable log file on the terminal
- -- if there is a failure and/or detailed output is requested
- let details = fromFlag $ testShowDetails flags
- whenPrinting = when $ (details > Never)
- && (not (suitePassed suiteLog) || details == Always)
- && verbosity >= normal
- whenPrinting $ readFile tempLog >>=
- putStr . unlines . lines
-
- -- Write summary notice to terminal indicating end of test suite
- notice verbosity $ summarizeSuiteFinish suiteLog'
-
- markupTest verbosity lbi distPref
- (display $ PD.package pkg_descr) suite
-
- return suiteLog'
- where
- deleteIfExists file = do
- exists <- doesFileExist file
- when exists $ removeFile file
-
- openCabalTemp testLogDir = do
- (f, h) <- openTempFile testLogDir $ "cabal-test-" <.> "log"
- hClose h >> return f
-
+import System.FilePath ( () )
-- |Perform the \"@.\/setup test@\" action.
test :: PD.PackageDescription -- ^information from the .cabal file
@@ -277,7 +48,6 @@
-> IO ()
test pkg_descr lbi flags = do
let verbosity = fromFlag $ testVerbosity flags
- humanTemplate = fromFlag $ testHumanLog flags
machineTemplate = fromFlag $ testMachineLog flags
distPref = fromFlag $ testDistPref flags
testLogDir = distPref "test"
@@ -288,51 +58,25 @@
, PD.buildable (PD.testBuildInfo t) ]
doTest :: (PD.TestSuite, Maybe TestSuiteLog) -> IO TestSuiteLog
- doTest (suite, _) = do
- let testLogPath = testSuiteLogPath humanTemplate pkg_descr lbi
- go pre cmd post = testController flags pkg_descr lbi suite
- pre cmd post testLogPath
+ doTest (suite, _) =
case PD.testInterface suite of
- PD.TestSuiteExeV10 _ _ -> do
- let cmd = LBI.buildDir lbi PD.testName suite
- PD.testName suite <.> exeExtension
- preTest _ = ""
- postTest exit _ =
- let r = case exit of
- ExitSuccess -> Pass
- ExitFailure c -> Fail
- $ "exit code: " ++ show c
- in TestSuiteLog
- { testSuiteName = PD.testName suite
- , testLogs = TestLog
- { testName = PD.testName suite
- , testOptionsReturned = []
- , testResult = r
- }
- , logFile = ""
- }
- go preTest cmd postTest
+ PD.TestSuiteExeV10 _ _ ->
+ ExeV10.runTest pkg_descr lbi flags suite
- PD.TestSuiteLibV09 _ _ -> do
- let cmd = LBI.buildDir lbi stubName suite
- stubName suite <.> exeExtension
- preTest f = show ( f
- , PD.testName suite
- )
- postTest _ = read
- go preTest cmd postTest
+ PD.TestSuiteLibV09 _ _ ->
+ LibV09.runTest pkg_descr lbi flags suite
_ -> return TestSuiteLog
- { testSuiteName = PD.testName suite
- , testLogs = TestLog
- { testName = PD.testName suite
- , testOptionsReturned = []
- , testResult = Error $
- "No support for running test suite type: "
- ++ show (disp $ PD.testType suite)
- }
- , logFile = ""
- }
+ { testSuiteName = PD.testName suite
+ , testLogs = TestLog
+ { testName = PD.testName suite
+ , testOptionsReturned = []
+ , testResult =
+ Error $ "No support for running test suite type: "
+ ++ show (disp $ PD.testType suite)
+ }
+ , logFile = ""
+ }
when (not $ PD.hasTests pkg_descr) $ do
notice verbosity "Package has no test suites."
@@ -376,81 +120,6 @@
unless allOk exitFailure
--- | Print a summary to the console after all test suites have been run
--- indicating the number of successful test suites and cases. Returns 'True' if
--- all test suites passed and 'False' otherwise.
-summarizePackage :: Verbosity -> PackageLog -> IO Bool
-summarizePackage verbosity packageLog = do
- let counts = map (countTestResults . testLogs) $ testSuites packageLog
- (passed, failed, errors) = foldl1 addTriple counts
- totalCases = passed + failed + errors
- passedSuites = length $ filter suitePassed $ testSuites packageLog
- totalSuites = length $ testSuites packageLog
- notice verbosity $ show passedSuites ++ " of " ++ show totalSuites
- ++ " test suites (" ++ show passed ++ " of "
- ++ show totalCases ++ " test cases) passed."
- return $! passedSuites == totalSuites
- where
- addTriple (p1, f1, e1) (p2, f2, e2) = (p1 + p2, f1 + f2, e1 + e2)
-
--- | Print a summary of a single test case's result to the console, supressing
--- output for certain verbosity or test filter levels.
-summarizeTest :: Verbosity -> TestShowDetails -> TestLogs -> IO ()
-summarizeTest _ _ (GroupLogs {}) = return ()
-summarizeTest verbosity details t =
- when shouldPrint $ notice verbosity $ "Test case " ++ testName t
- ++ ": " ++ show (testResult t)
- where shouldPrint = (details > Never) && (notPassed || details == Always)
- notPassed = testResult t /= Pass
-
--- | Print a summary of the test suite's results on the console, suppressing
--- output for certain verbosity or test filter levels.
-summarizeSuiteFinish :: TestSuiteLog -> String
-summarizeSuiteFinish testLog = unlines
- [ "Test suite " ++ testSuiteName testLog ++ ": " ++ resStr
- , "Test suite logged to: " ++ logFile testLog
- ]
- where resStr = map toUpper (resultString testLog)
-
-summarizeSuiteStart :: String -> String
-summarizeSuiteStart n = "Test suite " ++ n ++ ": RUNNING...\n"
-
-resultString :: TestSuiteLog -> String
-resultString l | suiteError l = "error"
- | suiteFailed l = "fail"
- | otherwise = "pass"
-
-testSuiteLogPath :: PathTemplate
- -> PD.PackageDescription
- -> LBI.LocalBuildInfo
- -> TestSuiteLog
- -> FilePath
-testSuiteLogPath template pkg_descr lbi testLog =
- fromPathTemplate $ substPathTemplate env template
- where
- env = initialPathTemplateEnv
- (PD.package pkg_descr) (compilerId $ LBI.compiler lbi)
- (LBI.hostPlatform lbi)
- ++ [ (TestSuiteNameVar, toPathTemplate $ testSuiteName testLog)
- , (TestSuiteResultVar, result)
- ]
- result = toPathTemplate $ resultString testLog
-
--- TODO: This is abusing the notion of a 'PathTemplate'. The result
--- isn't neccesarily a path.
-testOption :: PD.PackageDescription
- -> LBI.LocalBuildInfo
- -> PD.TestSuite
- -> PathTemplate
- -> String
-testOption pkg_descr lbi suite template =
- fromPathTemplate $ substPathTemplate env template
- where
- env = initialPathTemplateEnv
- (PD.package pkg_descr) (compilerId $ LBI.compiler lbi)
- (LBI.hostPlatform lbi) ++
- [(TestSuiteNameVar, toPathTemplate $ PD.testName suite)]
-
packageLogPath :: PathTemplate
-> PD.PackageDescription
-> LBI.LocalBuildInfo
@@ -461,87 +130,3 @@
env = initialPathTemplateEnv
(PD.package pkg_descr) (compilerId $ LBI.compiler lbi)
(LBI.hostPlatform lbi)
-
--- | The filename of the source file for the stub executable associated with a
--- library 'TestSuite'.
-stubFilePath :: PD.TestSuite -> FilePath
-stubFilePath t = stubName t <.> "hs"
-
--- | The name of the stub executable associated with a library 'TestSuite'.
-stubName :: PD.TestSuite -> FilePath
-stubName t = PD.testName t ++ "Stub"
-
--- | Write the source file for a library 'TestSuite' stub executable.
-writeSimpleTestStub :: PD.TestSuite -- ^ library 'TestSuite' for which a stub
- -- is being created
- -> FilePath -- ^ path to directory where stub source
- -- should be located
- -> IO ()
-writeSimpleTestStub t dir = do
- createDirectoryIfMissing True dir
- let filename = dir stubFilePath t
- PD.TestSuiteLibV09 _ m = PD.testInterface t
- writeFile filename $ simpleTestStub m
-
--- | Source code for library test suite stub executable
-simpleTestStub :: ModuleName -> String
-simpleTestStub m = unlines
- [ "module Main ( main ) where"
- , "import Distribution.Simple.Test ( stubMain )"
- , "import " ++ show (disp m) ++ " ( tests )"
- , "main :: IO ()"
- , "main = stubMain tests"
- ]
-
--- | Main function for test stubs. Once, it was written directly into the stub,
--- but minimizing the amount of code actually in the stub maximizes the number
--- of detectable errors when Cabal is compiled.
-stubMain :: IO [Test] -> IO ()
-stubMain tests = do
- (f, n) <- fmap read getContents
- dir <- getCurrentDirectory
- results <- tests >>= stubRunTests
- setCurrentDirectory dir
- stubWriteLog f n results
-
--- | The test runner used in library "TestSuite" stub executables. Runs a list
--- of 'Test's. An executable calling this function is meant to be invoked as
--- the child of a Cabal process during @.\/setup test@. A 'TestSuiteLog',
--- provided by Cabal, is read from the standard input; it supplies the name of
--- the test suite and the location of the machine-readable test suite log file.
--- Human-readable log information is written to the standard output for capture
--- by the calling Cabal process.
-stubRunTests :: [Test] -> IO TestLogs
-stubRunTests tests = do
- logs <- mapM stubRunTests' tests
- return $ GroupLogs "Default" logs
- where
- stubRunTests' (Test t) = do
- l <- run t >>= finish
- summarizeTest normal Always l
- return l
- where
- finish (Finished result) =
- return TestLog
- { testName = name t
- , testOptionsReturned = defaultOptions t
- , testResult = result
- }
- finish (Progress _ next) = next >>= finish
- stubRunTests' g@(Group {}) = do
- logs <- mapM stubRunTests' $ groupTests g
- return $ GroupLogs (groupName g) logs
- stubRunTests' (ExtraOptions _ t) = stubRunTests' t
- maybeDefaultOption opt =
- maybe Nothing (\d -> Just (optionName opt, d)) $ optionDefault opt
- defaultOptions testInst = mapMaybe maybeDefaultOption $ options testInst
-
--- | From a test stub, write the 'TestSuiteLog' to temporary file for the calling
--- Cabal process to read.
-stubWriteLog :: FilePath -> String -> TestLogs -> IO ()
-stubWriteLog f n logs = do
- let testLog = TestSuiteLog { testSuiteName = n, testLogs = logs, logFile = f }
- writeFile (logFile testLog) $ show testLog
- when (suiteError testLog) $ exitWith $ ExitFailure 2
- when (suiteFailed testLog) $ exitWith $ ExitFailure 1
- exitWith ExitSuccess
diff --git a/Distribution/Simple/Test/ExeV10.hs b/Distribution/Simple/Test/ExeV10.hs
new file mode 100644
--- /dev/null
+++ b/Distribution/Simple/Test/ExeV10.hs
@@ -0,0 +1,146 @@
+module Distribution.Simple.Test.ExeV10
+ ( runTest
+ ) where
+
+import Distribution.Compat.CreatePipe ( createPipe, tee )
+import Distribution.Compat.Environment ( getEnvironment )
+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.InstallDirs
+ ( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..)
+ , substPathTemplate , toPathTemplate, PathTemplate )
+import qualified Distribution.Simple.LocalBuildInfo as LBI
+import Distribution.Simple.Setup ( TestFlags(..), TestShowDetails(..), fromFlag )
+import Distribution.Simple.Test.Log
+import Distribution.Simple.Utils ( die, notice, rawSystemIOWithEnv )
+import Distribution.TestSuite
+import Distribution.Text
+import Distribution.Verbosity ( normal )
+
+import Control.Monad ( when, unless )
+import System.Directory
+ ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
+ , getCurrentDirectory, removeDirectoryRecursive )
+import System.Exit ( ExitCode(..) )
+import System.FilePath ( (), (<.>) )
+import System.IO ( hGetContents, stdout )
+
+runTest :: PD.PackageDescription
+ -> LBI.LocalBuildInfo
+ -> TestFlags
+ -> PD.TestSuite
+ -> IO TestSuiteLog
+runTest pkg_descr lbi flags suite = do
+ pwd <- getCurrentDirectory
+ existingEnv <- getEnvironment
+
+ let cmd = LBI.buildDir lbi PD.testName suite
+ PD.testName suite <.> exeExtension
+ -- Check that the test executable exists.
+ exists <- doesFileExist cmd
+ unless exists $ die $ "Error: Could not find test program \"" ++ cmd
+ ++ "\". Did you build the package first?"
+
+ -- 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
+
+ -- Create directory for HPC files.
+ createDirectoryIfMissing True $ tixDir distPref $ PD.testName suite
+
+ -- Write summary notices indicating start of test suite
+ notice verbosity $ summarizeSuiteStart $ PD.testName suite
+
+ -- Run test executable
+ (rLog, wLog) <- createPipe
+ 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)
+ : existingEnv
+
+ (rOut, wOut) <- createPipe
+ let outHandles | details == Streaming = [(stdout, False)]
+ | otherwise = []
+ tee rOut $ (wLog, True) : outHandles
+ exit <- rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv)
+ -- these handles are automatically closed
+ Nothing (Just wOut) (Just wOut)
+
+ -- Generate TestSuiteLog from executable exit code and a machine-
+ -- readable test log
+ let suiteLog = buildLog exit
+
+ -- Write summary notice to log file indicating start of test suite
+ appendFile (logFile suiteLog) $ summarizeSuiteStart $ PD.testName suite
+
+ -- Append contents of temporary log file to the final human-
+ -- readable log file
+ logText <- hGetContents rLog
+ appendFile (logFile suiteLog) logText
+
+ -- Write end-of-suite summary notice to log file
+ appendFile (logFile suiteLog) $ summarizeSuiteFinish suiteLog
+
+ -- Show the contents of the human-readable log file on the terminal
+ -- if there is a failure and/or detailed output is requested
+ let
+ whenPrinting = when $ (details > Never)
+ && (not (suitePassed $ testLogs suiteLog) || details == Always)
+ && verbosity >= normal -- verbosity overrides show-details
+ && details /= Streaming -- If streaming, we already printed the log
+ whenPrinting $ putStr $ unlines $ lines logText
+
+ -- Write summary notice to terminal indicating end of test suite
+ notice verbosity $ summarizeSuiteFinish suiteLog
+
+ markupTest verbosity lbi distPref
+ (display $ PD.package pkg_descr) suite
+
+ return suiteLog
+ where
+ distPref = fromFlag $ testDistPref flags
+ verbosity = fromFlag $ testVerbosity flags
+ details = fromFlag $ testShowDetails flags
+ testLogDir = distPref "test"
+
+ buildLog exit =
+ let r = case exit of
+ ExitSuccess -> Pass
+ ExitFailure c -> Fail $ "exit code: " ++ show c
+ n = PD.testName suite
+ l = TestLog
+ { testName = n
+ , testOptionsReturned = []
+ , testResult = r
+ }
+ in TestSuiteLog
+ { testSuiteName = n
+ , testLogs = l
+ , logFile =
+ testLogDir
+ testSuiteLogPath (fromFlag $ testHumanLog flags)
+ pkg_descr lbi n l
+ }
+
+-- TODO: This is abusing the notion of a 'PathTemplate'. The result
+-- isn't neccesarily a path.
+testOption :: PD.PackageDescription
+ -> LBI.LocalBuildInfo
+ -> PD.TestSuite
+ -> PathTemplate
+ -> String
+testOption pkg_descr lbi suite template =
+ fromPathTemplate $ substPathTemplate env template
+ where
+ env = initialPathTemplateEnv
+ (PD.package pkg_descr) (compilerId $ 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
new file mode 100644
--- /dev/null
+++ b/Distribution/Simple/Test/LibV09.hs
@@ -0,0 +1,239 @@
+module Distribution.Simple.Test.LibV09
+ ( runTest
+ -- Test stub
+ , simpleTestStub
+ , stubFilePath, stubMain, stubName, stubWriteLog
+ , writeSimpleTestStub
+ ) where
+
+import Distribution.Compat.CreatePipe ( createPipe )
+import Distribution.Compat.Environment ( getEnvironment )
+import Distribution.Compat.TempFile ( openTempFile )
+import Distribution.ModuleName ( ModuleName )
+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.InstallDirs
+ ( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..)
+ , substPathTemplate , toPathTemplate, PathTemplate )
+import qualified Distribution.Simple.LocalBuildInfo as LBI
+import Distribution.Simple.Setup ( TestFlags(..), TestShowDetails(..), fromFlag )
+import Distribution.Simple.Test.Log
+import Distribution.Simple.Utils ( die, notice, rawSystemIOWithEnv )
+import Distribution.TestSuite
+import Distribution.Text
+import Distribution.Verbosity ( normal )
+
+import Control.Exception ( bracket )
+import Control.Monad ( when, unless )
+import Data.Maybe ( mapMaybe )
+import System.Directory
+ ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
+ , getCurrentDirectory, removeDirectoryRecursive, removeFile
+ , setCurrentDirectory )
+import System.Exit ( ExitCode(..), exitWith )
+import System.FilePath ( (), (<.>) )
+import System.IO ( hClose, hGetContents, hPutStr )
+
+runTest :: PD.PackageDescription
+ -> LBI.LocalBuildInfo
+ -> TestFlags
+ -> PD.TestSuite
+ -> IO TestSuiteLog
+runTest pkg_descr lbi flags suite = do
+ pwd <- getCurrentDirectory
+ existingEnv <- getEnvironment
+
+ let cmd = LBI.buildDir lbi stubName suite
+ stubName suite <.> exeExtension
+ -- Check that the test executable exists.
+ exists <- doesFileExist cmd
+ unless exists $ die $ "Error: Could not find test program \"" ++ cmd
+ ++ "\". Did you build the package first?"
+
+ -- 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
+
+ -- Create directory for HPC files.
+ createDirectoryIfMissing True $ tixDir distPref $ PD.testName suite
+
+ -- Write summary notices indicating start of test suite
+ notice verbosity $ summarizeSuiteStart $ PD.testName suite
+
+ suiteLog <- bracket openCabalTemp deleteIfExists $ \tempLog -> do
+
+ (rIn, wIn) <- createPipe
+ (rOut, wOut) <- createPipe
+
+ -- Prepare standard input for test executable
+ --appendFile tempInput $ show (tempInput, PD.testName suite)
+ hPutStr wIn $ show (tempLog, PD.testName suite)
+ hClose wIn
+
+ -- 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)
+ : existingEnv
+ rawSystemIOWithEnv verbosity cmd opts Nothing (Just shellEnv)
+ -- these handles are closed automatically
+ (Just rIn) (Just wOut) (Just wOut)
+
+ -- Generate final log file name
+ let finalLogName l = testLogDir
+ testSuiteLogPath
+ (fromFlag $ testHumanLog flags) pkg_descr lbi
+ (testSuiteName l) (testLogs l)
+ -- Generate TestSuiteLog from executable exit code and a machine-
+ -- readable test log
+ suiteLog <- fmap ((\l -> l { logFile = finalLogName l }) . read)
+ $ readFile tempLog
+
+ -- Write summary notice to log file indicating start of test suite
+ appendFile (logFile suiteLog) $ summarizeSuiteStart $ PD.testName suite
+
+ -- Append contents of temporary log file to the final human-
+ -- readable log file
+ logText <- hGetContents rOut
+ appendFile (logFile suiteLog) logText
+
+ -- Write end-of-suite summary notice to log file
+ appendFile (logFile suiteLog) $ summarizeSuiteFinish suiteLog
+
+ -- Show the contents of the human-readable log file on the terminal
+ -- if there is a failure and/or detailed output is requested
+ let details = fromFlag $ testShowDetails flags
+ whenPrinting = when $ (details > Never)
+ && (not (suitePassed $ testLogs suiteLog) || details == Always)
+ && verbosity >= normal
+ whenPrinting $ putStr $ unlines $ lines logText
+
+ return suiteLog
+
+ -- Write summary notice to terminal indicating end of test suite
+ notice verbosity $ summarizeSuiteFinish suiteLog
+
+ markupTest verbosity lbi distPref
+ (display $ PD.package pkg_descr) suite
+
+ return suiteLog
+ where
+ deleteIfExists file = do
+ exists <- doesFileExist file
+ when exists $ removeFile file
+
+ testLogDir = distPref "test"
+ openCabalTemp = do
+ (f, h) <- openTempFile testLogDir $ "cabal-test-" <.> "log"
+ hClose h >> return f
+
+ distPref = fromFlag $ testDistPref flags
+ verbosity = fromFlag $ testVerbosity flags
+
+-- TODO: This is abusing the notion of a 'PathTemplate'. The result
+-- isn't neccesarily a path.
+testOption :: PD.PackageDescription
+ -> LBI.LocalBuildInfo
+ -> PD.TestSuite
+ -> PathTemplate
+ -> String
+testOption pkg_descr lbi suite template =
+ fromPathTemplate $ substPathTemplate env template
+ where
+ env = initialPathTemplateEnv
+ (PD.package pkg_descr) (compilerId $ LBI.compiler lbi)
+ (LBI.hostPlatform lbi) ++
+ [(TestSuiteNameVar, toPathTemplate $ PD.testName suite)]
+
+-- Test stub ----------
+
+-- | The name of the stub executable associated with a library 'TestSuite'.
+stubName :: PD.TestSuite -> FilePath
+stubName t = PD.testName t ++ "Stub"
+
+-- | The filename of the source file for the stub executable associated with a
+-- library 'TestSuite'.
+stubFilePath :: PD.TestSuite -> FilePath
+stubFilePath t = stubName t <.> "hs"
+
+-- | Write the source file for a library 'TestSuite' stub executable.
+writeSimpleTestStub :: PD.TestSuite -- ^ library 'TestSuite' for which a stub
+ -- is being created
+ -> FilePath -- ^ path to directory where stub source
+ -- should be located
+ -> IO ()
+writeSimpleTestStub t dir = do
+ createDirectoryIfMissing True dir
+ let filename = dir stubFilePath t
+ PD.TestSuiteLibV09 _ m = PD.testInterface t
+ writeFile filename $ simpleTestStub m
+
+-- | Source code for library test suite stub executable
+simpleTestStub :: ModuleName -> String
+simpleTestStub m = unlines
+ [ "module Main ( main ) where"
+ , "import Distribution.Simple.Test.LibV09 ( stubMain )"
+ , "import " ++ show (disp m) ++ " ( tests )"
+ , "main :: IO ()"
+ , "main = stubMain tests"
+ ]
+
+-- | Main function for test stubs. Once, it was written directly into the stub,
+-- but minimizing the amount of code actually in the stub maximizes the number
+-- of detectable errors when Cabal is compiled.
+stubMain :: IO [Test] -> IO ()
+stubMain tests = do
+ (f, n) <- fmap read getContents
+ dir <- getCurrentDirectory
+ results <- tests >>= stubRunTests
+ setCurrentDirectory dir
+ stubWriteLog f n results
+
+-- | The test runner used in library "TestSuite" stub executables. Runs a list
+-- of 'Test's. An executable calling this function is meant to be invoked as
+-- the child of a Cabal process during @.\/setup test@. A 'TestSuiteLog',
+-- provided by Cabal, is read from the standard input; it supplies the name of
+-- the test suite and the location of the machine-readable test suite log file.
+-- Human-readable log information is written to the standard output for capture
+-- by the calling Cabal process.
+stubRunTests :: [Test] -> IO TestLogs
+stubRunTests tests = do
+ logs <- mapM stubRunTests' tests
+ return $ GroupLogs "Default" logs
+ where
+ stubRunTests' (Test t) = do
+ l <- run t >>= finish
+ summarizeTest normal Always l
+ return l
+ where
+ finish (Finished result) =
+ return TestLog
+ { testName = name t
+ , testOptionsReturned = defaultOptions t
+ , testResult = result
+ }
+ finish (Progress _ next) = next >>= finish
+ stubRunTests' g@(Group {}) = do
+ logs <- mapM stubRunTests' $ groupTests g
+ return $ GroupLogs (groupName g) logs
+ stubRunTests' (ExtraOptions _ t) = stubRunTests' t
+ maybeDefaultOption opt =
+ maybe Nothing (\d -> Just (optionName opt, d)) $ optionDefault opt
+ defaultOptions testInst = mapMaybe maybeDefaultOption $ options testInst
+
+-- | From a test stub, write the 'TestSuiteLog' to temporary file for the calling
+-- Cabal process to read.
+stubWriteLog :: FilePath -> String -> TestLogs -> IO ()
+stubWriteLog f n logs = do
+ let testLog = TestSuiteLog { testSuiteName = n, testLogs = logs, logFile = f }
+ writeFile (logFile testLog) $ show testLog
+ when (suiteError logs) $ exitWith $ ExitFailure 2
+ when (suiteFailed logs) $ exitWith $ ExitFailure 1
+ exitWith ExitSuccess
diff --git a/Distribution/Simple/Test/Log.hs b/Distribution/Simple/Test/Log.hs
new file mode 100644
--- /dev/null
+++ b/Distribution/Simple/Test/Log.hs
@@ -0,0 +1,161 @@
+module Distribution.Simple.Test.Log
+ ( PackageLog(..)
+ , TestLogs(..)
+ , TestSuiteLog(..)
+ , countTestResults
+ , localPackageLog
+ , summarizePackage
+ , summarizeSuiteFinish, summarizeSuiteStart
+ , summarizeTest
+ , suiteError, suiteFailed, suitePassed
+ , testSuiteLogPath
+ ) where
+
+import Distribution.Package ( PackageId )
+import qualified Distribution.PackageDescription as PD
+import Distribution.Simple.Compiler ( Compiler(..), CompilerId )
+import Distribution.Simple.InstallDirs
+ ( fromPathTemplate, initialPathTemplateEnv, PathTemplateVariable(..)
+ , substPathTemplate , toPathTemplate, PathTemplate )
+import qualified Distribution.Simple.LocalBuildInfo as LBI
+import Distribution.Simple.Setup ( TestShowDetails(..) )
+import Distribution.Simple.Utils ( notice )
+import Distribution.System ( Platform )
+import Distribution.TestSuite ( Options, Result(..) )
+import Distribution.Verbosity ( Verbosity )
+
+import Control.Monad ( when )
+import Data.Char ( toUpper )
+
+-- | Logs all test results for a package, broken down first by test suite and
+-- then by test case.
+data PackageLog = PackageLog
+ { package :: PackageId
+ , compiler :: CompilerId
+ , platform :: Platform
+ , testSuites :: [TestSuiteLog]
+ }
+ deriving (Read, Show, Eq)
+
+-- | A 'PackageLog' with package and platform information specified.
+localPackageLog :: PD.PackageDescription -> LBI.LocalBuildInfo -> PackageLog
+localPackageLog pkg_descr lbi = PackageLog
+ { package = PD.package pkg_descr
+ , compiler = compilerId $ LBI.compiler lbi
+ , platform = LBI.hostPlatform lbi
+ , testSuites = []
+ }
+
+-- | Logs test suite results, itemized by test case.
+data TestSuiteLog = TestSuiteLog
+ { testSuiteName :: String
+ , testLogs :: TestLogs
+ , logFile :: FilePath -- path to human-readable log file
+ }
+ deriving (Read, Show, Eq)
+
+data TestLogs
+ = TestLog
+ { testName :: String
+ , testOptionsReturned :: Options
+ , testResult :: Result
+ }
+ | GroupLogs String [TestLogs]
+ deriving (Read, Show, Eq)
+
+-- | Count the number of pass, fail, and error test results in a 'TestLogs'
+-- tree.
+countTestResults :: TestLogs
+ -> (Int, Int, Int) -- ^ Passes, fails, and errors,
+ -- respectively.
+countTestResults = go (0, 0, 0)
+ where
+ go (p, f, e) (TestLog { testResult = r }) =
+ case r of
+ Pass -> (p + 1, f, e)
+ Fail _ -> (p, f + 1, e)
+ Error _ -> (p, f, e + 1)
+ go (p, f, e) (GroupLogs _ ts) = foldl go (p, f, e) ts
+
+-- | From a 'TestSuiteLog', determine if the test suite passed.
+suitePassed :: TestLogs -> Bool
+suitePassed l =
+ case countTestResults l of
+ (_, 0, 0) -> True
+ _ -> False
+
+-- | From a 'TestSuiteLog', determine if the test suite failed.
+suiteFailed :: TestLogs -> Bool
+suiteFailed l =
+ case countTestResults l of
+ (_, 0, _) -> False
+ _ -> True
+
+-- | From a 'TestSuiteLog', determine if the test suite encountered errors.
+suiteError :: TestLogs -> Bool
+suiteError l =
+ case countTestResults l of
+ (_, _, 0) -> False
+ _ -> True
+
+resultString :: TestLogs -> String
+resultString l | suiteError l = "error"
+ | suiteFailed l = "fail"
+ | otherwise = "pass"
+
+testSuiteLogPath :: PathTemplate
+ -> PD.PackageDescription
+ -> LBI.LocalBuildInfo
+ -> String -- ^ test suite name
+ -> TestLogs -- ^ test suite results
+ -> FilePath
+testSuiteLogPath template pkg_descr lbi name result =
+ fromPathTemplate $ substPathTemplate env template
+ where
+ env = initialPathTemplateEnv
+ (PD.package pkg_descr) (compilerId $ LBI.compiler lbi)
+ (LBI.hostPlatform lbi)
+ ++ [ (TestSuiteNameVar, toPathTemplate name)
+ , (TestSuiteResultVar, toPathTemplate $ resultString result)
+ ]
+
+-- | Print a summary to the console after all test suites have been run
+-- indicating the number of successful test suites and cases. Returns 'True' if
+-- all test suites passed and 'False' otherwise.
+summarizePackage :: Verbosity -> PackageLog -> IO Bool
+summarizePackage verbosity packageLog = do
+ let counts = map (countTestResults . testLogs) $ testSuites packageLog
+ (passed, failed, errors) = foldl1 addTriple counts
+ totalCases = passed + failed + errors
+ passedSuites = length
+ $ filter (suitePassed . testLogs)
+ $ testSuites packageLog
+ totalSuites = length $ testSuites packageLog
+ notice verbosity $ show passedSuites ++ " of " ++ show totalSuites
+ ++ " test suites (" ++ show passed ++ " of "
+ ++ show totalCases ++ " test cases) passed."
+ return $! passedSuites == totalSuites
+ where
+ addTriple (p1, f1, e1) (p2, f2, e2) = (p1 + p2, f1 + f2, e1 + e2)
+
+-- | Print a summary of a single test case's result to the console, supressing
+-- output for certain verbosity or test filter levels.
+summarizeTest :: Verbosity -> TestShowDetails -> TestLogs -> IO ()
+summarizeTest _ _ (GroupLogs {}) = return ()
+summarizeTest verbosity details t =
+ when shouldPrint $ notice verbosity $ "Test case " ++ testName t
+ ++ ": " ++ show (testResult t)
+ where shouldPrint = (details > Never) && (notPassed || details == Always)
+ notPassed = testResult t /= Pass
+
+-- | Print a summary of the test suite's results on the console, suppressing
+-- output for certain verbosity or test filter levels.
+summarizeSuiteFinish :: TestSuiteLog -> String
+summarizeSuiteFinish testLog = unlines
+ [ "Test suite " ++ testSuiteName testLog ++ ": " ++ resStr
+ , "Test suite logged to: " ++ logFile testLog
+ ]
+ where resStr = map toUpper (resultString $ testLogs testLog)
+
+summarizeSuiteStart :: String -> String
+summarizeSuiteStart n = "Test suite " ++ n ++ ": RUNNING...\n"
diff --git a/Distribution/Simple/UHC.hs b/Distribution/Simple/UHC.hs
--- a/Distribution/Simple/UHC.hs
+++ b/Distribution/Simple/UHC.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.UHC
-- Copyright : Andres Loeh 2009
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -13,39 +14,6 @@
-- particular to Isaac Jones, Duncan Coutts and Henning Thielemann, for
-- inspiration on how to design this module.
-{-
-Copyright (c) 2009, Andres Loeh
-Copyright (c) 2003-2005, Isaac Jones
-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 Isaac Jones 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. -}
-
module Distribution.Simple.UHC (
configure, getInstalledPackages,
buildLib, buildExe, installLib, registerPackage
@@ -53,6 +21,7 @@
import Control.Monad
import Data.List
+import qualified Data.Map as M ( empty )
import Distribution.Compat.ReadP
import Distribution.InstalledPackageInfo
import Distribution.Package
@@ -86,7 +55,8 @@
let comp = Compiler {
compilerId = CompilerId UHC uhcVersion,
compilerLanguages = uhcLanguages,
- compilerExtensions = uhcLanguageExtensions
+ compilerExtensions = uhcLanguageExtensions,
+ compilerProperties = M.empty
}
compPlatform = Nothing
return (comp, compPlatform, conf')
@@ -148,7 +118,7 @@
UserPackageDB -> [ user ]
SpecificPackageDB path -> [ path ]
--- | Hack to add version numbers to UHC-builtin packages. This should sooner or
+-- | Hack to add version numbers to UHC-built-in packages. This should sooner or
-- later be fixed on the UHC side.
addBuiltinVersions :: String -> String
{-
@@ -245,6 +215,8 @@
++ ["-i" ++ odir]
++ ["-i" ++ l | l <- nub (hsSourceDirs bi)]
++ ["-i" ++ autogenModulesDir lbi]
+ -- cpp options
+ ++ ["--optP=" ++ opt | opt <- cppOptions bi]
-- output path
++ ["--odir=" ++ odir]
-- optimization
@@ -268,7 +240,7 @@
-- putStrLn $ "built: " ++ builtDir
installDirectoryContents verbosity (builtDir display (packageId pkg)) targetDir
--- currently hardcoded UHC code generator and variant to use
+-- currently hard-coded UHC code generator and variant to use
uhcTarget, uhcTargetVariant :: String
uhcTarget = "bc"
uhcTargetVariant = "plain"
diff --git a/Distribution/Simple/UserHooks.hs b/Distribution/Simple/UserHooks.hs
--- a/Distribution/Simple/UserHooks.hs
+++ b/Distribution/Simple/UserHooks.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Simple.UserHooks
-- Copyright : Isaac Jones 2003-2005
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -22,36 +23,6 @@
-- various phases because it would involve changing the types of the
-- corresponding hook. At some point it will have to be replaced.
-{- 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 Isaac Jones 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. -}
-
module Distribution.Simple.UserHooks (
UserHooks(..), Args,
emptyUserHooks,
@@ -100,7 +71,7 @@
-- |Hook to run before build command. Second arg indicates verbosity level.
preBuild :: Args -> BuildFlags -> IO HookedBuildInfo,
- -- |Over-ride this hook to gbet different behavior during build.
+ -- |Over-ride this hook to get different behavior during build.
buildHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO (),
-- |Hook to run after build command. Second arg indicates verbosity level.
postBuild :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO (),
diff --git a/Distribution/Simple/Utils.hs b/Distribution/Simple/Utils.hs
--- a/Distribution/Simple/Utils.hs
+++ b/Distribution/Simple/Utils.hs
@@ -3,6 +3,7 @@
-- |
-- Module : Distribution.Simple.Utils
-- Copyright : Isaac Jones, Simon Marlow 2003-2004
+-- License : BSD3
-- portions Copyright (c) 2007, Galois Inc.
--
-- Maintainer : cabal-devel@haskell.org
@@ -14,36 +15,6 @@
-- has low level functions for running programs, a bunch of wrappers for
-- various directory and file functions that do extra logging.
-{- 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 Isaac Jones 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. -}
-
module Distribution.Simple.Utils (
cabalVersion,
@@ -84,6 +55,7 @@
installDirectoryContents,
-- * File permissions
+ doesExecutableExist,
setFileOrdinary,
setFileExecutable,
@@ -110,6 +82,7 @@
-- * modification time
moreRecentFile,
+ existsAndIsMoreRecentThan,
-- * temp files and dirs
TempFileOptions(..), defaultTempFileOptions,
@@ -119,6 +92,7 @@
-- * .cabal and .buildinfo files
defaultPackageDesc,
findPackageDesc,
+ tryFindPackageDesc,
defaultHookedPackageDesc,
findHookedPackageDesc,
@@ -146,7 +120,7 @@
) where
import Control.Monad
- ( when, unless, filterM )
+ ( join, when, unless, filterM )
import Control.Concurrent.MVar
( newEmptyMVar, putMVar, takeMVar )
import Data.List
@@ -424,7 +398,7 @@
return ()
#endif /* mingw32_HOST_OS */
--- Exit with the same exitcode if the subcommand fails
+-- Exit with the same exit code if the subcommand fails
rawSystemExit :: Verbosity -> FilePath -> [String] -> IO ()
rawSystemExit verbosity path args = do
printRawCommandAndArgs verbosity path args
@@ -606,7 +580,7 @@
return version
--- | Like the unix xargs program. Useful for when we've got very long command
+-- | Like the Unix xargs program. Useful for when we've got very long command
-- lines that might overflow an OS limit on command line length and so you
-- need to invoke a command multiple times to get all the args in.
--
@@ -730,7 +704,8 @@
return (files ++ files')
where
- collect files dirs' [] = return (reverse files, reverse dirs')
+ collect files dirs' [] = return (reverse files
+ ,reverse dirs')
collect files dirs' (entry:entries) | ignore entry
= collect files dirs' entries
collect files dirs' (entry:entries) = do
@@ -810,6 +785,14 @@
ta <- getModificationTime a
return (ta > tb)
+-- | Like 'moreRecentFile', but also checks that the first file exists.
+existsAndIsMoreRecentThan :: FilePath -> FilePath -> IO Bool
+existsAndIsMoreRecentThan a b = do
+ exists <- doesFileExist a
+ if not exists
+ then return False
+ else a `moreRecentFile` b
+
----------------------------------------
-- Copying and installing files and dirs
@@ -842,7 +825,7 @@
-- createDirectory (and indeed POSIX mkdir) does not distinguish
-- between a dir already existing and a file already existing. So we
-- check for it here. Unfortunately there is a slight race condition
- -- here, but we think it is benign. It could report an exeption in
+ -- here, but we think it is benign. It could report an exception in
-- the case that the dir did exist but another process deletes the
-- directory and creates a file in its place before we can check
-- that the directory did indeed exist.
@@ -970,6 +953,18 @@
srcFiles <- getDirectoryContentsRecursive srcDir
installOrdinaryFiles verbosity destDir [ (srcDir, f) | f <- srcFiles ]
+-------------------
+-- File permissions
+
+-- | Like 'doesFileExist', but also checks that the file is executable.
+doesExecutableExist :: FilePath -> IO Bool
+doesExecutableExist f = do
+ exists <- doesFileExist f
+ if exists
+ then do perms <- getPermissions f
+ return (executable perms)
+ else return False
+
---------------------------------
-- Deprecated file copy functions
@@ -1082,6 +1077,7 @@
-- the same as the existing content then leave the file as is so that we do not
-- update the file's modification time.
--
+-- NB: the file is assumed to be ASCII-encoded.
rewriteFile :: FilePath -> String -> IO ()
rewriteFile path newContent =
flip catchIO mightNotExist $ do
@@ -1106,12 +1102,12 @@
-- |Package description file (/pkgname/@.cabal@)
defaultPackageDesc :: Verbosity -> IO FilePath
-defaultPackageDesc _verbosity = findPackageDesc currentDir
+defaultPackageDesc _verbosity = tryFindPackageDesc currentDir
-- |Find a package description file in the given directory. Looks for
-- @.cabal@ files.
-findPackageDesc :: FilePath -- ^Where to look
- -> IO FilePath -- ^.cabal
+findPackageDesc :: FilePath -- ^Where to look
+ -> IO (Either String FilePath) -- ^.cabal
findPackageDesc dir
= do files <- getDirectoryContents dir
-- to make sure we do not mistake a ~/.cabal/ dir for a .cabal
@@ -1122,20 +1118,24 @@
, let (name, ext) = splitExtension file
, not (null name) && ext == ".cabal" ]
case cabalFiles of
- [] -> noDesc
- [cabalFile] -> return cabalFile
- multiple -> multiDesc multiple
+ [] -> return (Left noDesc)
+ [cabalFile] -> return (Right cabalFile)
+ multiple -> return (Left $ multiDesc multiple)
where
- noDesc :: IO a
- noDesc = die $ "No cabal file found.\n"
- ++ "Please create a package description file .cabal"
+ noDesc :: String
+ noDesc = "No cabal file found.\n"
+ ++ "Please create a package description file .cabal"
- multiDesc :: [String] -> IO a
- multiDesc l = die $ "Multiple cabal files found.\n"
- ++ "Please use only one of: "
- ++ intercalate ", " l
+ multiDesc :: [String] -> String
+ multiDesc l = "Multiple cabal files found.\n"
+ ++ "Please use only one of: "
+ ++ intercalate ", " l
+-- |Like 'findPackageDesc', but calls 'die' in case of error.
+tryFindPackageDesc :: FilePath -> IO FilePath
+tryFindPackageDesc dir = join . fmap (either die return) $ findPackageDesc dir
+
-- |Optional auxiliary package information file (/pkgname/@.buildinfo@)
defaultHookedPackageDesc :: IO (Maybe FilePath)
defaultHookedPackageDesc = findHookedPackageDesc currentDir
@@ -1263,7 +1263,7 @@
normaliseLineEndings :: String -> String
normaliseLineEndings [] = []
normaliseLineEndings ('\r':'\n':s) = '\n' : normaliseLineEndings s -- windows
-normaliseLineEndings ('\r':s) = '\n' : normaliseLineEndings s -- old osx
+normaliseLineEndings ('\r':s) = '\n' : normaliseLineEndings s -- old OS X
normaliseLineEndings ( c :s) = c : normaliseLineEndings s
-- ------------------------------------------------------------
diff --git a/Distribution/System.hs b/Distribution/System.hs
--- a/Distribution/System.hs
+++ b/Distribution/System.hs
@@ -45,13 +45,13 @@
-- The reason we have multiple ways to do the classification is because there
-- are two situations where we need to do it.
--
--- For parsing os and arch names in .cabal files we really want everyone to be
+-- For parsing OS and arch names in .cabal files we really want everyone to be
-- referring to the same or or arch by the same name. Variety is not a virtue
-- in this case. We don't mind about case though.
--
-- For the System.Info.os\/arch different Haskell implementations use different
-- names for the same or\/arch. Also they tend to distinguish versions of an
--- os\/arch which we just don't care about.
+-- OS\/arch which we just don't care about.
--
-- The 'Compat' classification allows us to recognise aliases that are already
-- in common use but it allows us to distinguish them from the canonical name
@@ -64,7 +64,8 @@
-- ------------------------------------------------------------
data OS = Linux | Windows | OSX -- tier 1 desktop OSs
- | FreeBSD | OpenBSD | NetBSD -- other free unix OSs
+ | FreeBSD | OpenBSD | NetBSD -- other free Unix OSs
+ | DragonFly
| Solaris | AIX | HPUX | IRIX -- ageing Unix OSs
| HaLVM -- bare metal / VMs / hypervisors
| IOS -- iOS
@@ -73,12 +74,12 @@
--TODO: decide how to handle Android and iOS.
-- They are like Linux and OSX but with some differences.
--- Should they be separate from linux/osx, or a subtype?
+-- Should they be separate from Linux/OS X, or a subtype?
-- e.g. should we have os(linux) && os(android) true simultaneously?
knownOSs :: [OS]
knownOSs = [Linux, Windows, OSX
- ,FreeBSD, OpenBSD, NetBSD
+ ,FreeBSD, OpenBSD, NetBSD, DragonFly
,Solaris, AIX, HPUX, IRIX
,HaLVM
,IOS]
@@ -87,7 +88,6 @@
osAliases Permissive Windows = ["mingw32", "win32", "cygwin32"]
osAliases Compat Windows = ["mingw32", "win32"]
osAliases _ OSX = ["darwin"]
-osAliases _ IOS = ["ios"]
osAliases Permissive FreeBSD = ["kfreebsdgnu"]
osAliases Compat FreeBSD = ["kfreebsdgnu"]
osAliases Permissive Solaris = ["solaris2"]
diff --git a/Distribution/TestSuite.hs b/Distribution/TestSuite.hs
--- a/Distribution/TestSuite.hs
+++ b/Distribution/TestSuite.hs
@@ -2,42 +2,13 @@
-- |
-- Module : Distribution.TestSuite
-- Copyright : Thomas Tuegel 2010
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- This module defines the detailed test suite interface which makes it
-- possible to expose individual tests to Cabal or other test agents.
-
-{- 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 Isaac Jones 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. -}
module Distribution.TestSuite
( TestInstance(..)
diff --git a/Distribution/Verbosity.hs b/Distribution/Verbosity.hs
--- a/Distribution/Verbosity.hs
+++ b/Distribution/Verbosity.hs
@@ -2,6 +2,7 @@
-- |
-- Module : Distribution.Verbosity
-- Copyright : Ian Lynagh 2007
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -10,38 +11,7 @@
-- verbosity levels from 'silent', 'normal', 'verbose' up to 'deafening'. This
-- is used for deciding what logging messages to print.
--- Verbosity for Cabal functions
-
-{- Copyright (c) 2007, Ian Lynagh
-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 Isaac Jones 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. -}
+-- Verbosity for Cabal functions.
module Distribution.Verbosity (
-- * Verbosity
diff --git a/Distribution/Version.hs b/Distribution/Version.hs
--- a/Distribution/Version.hs
+++ b/Distribution/Version.hs
@@ -4,6 +4,7 @@
-- Module : Distribution.Version
-- Copyright : Isaac Jones, Simon Marlow 2003-2004
-- Duncan Coutts 2008
+-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
@@ -12,37 +13,6 @@
-- is something like @\"1.3.3\"@. It also defines the 'VersionRange' data
-- types. Version ranges are like @\">= 1.2 && < 2\"@.
-{- Copyright (c) 2003-2004, Isaac Jones
-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 Isaac Jones 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. -}
-
module Distribution.Version (
-- * Package versions
Version(..),
@@ -68,6 +38,9 @@
foldVersionRange,
foldVersionRange',
+ -- ** Modification
+ removeUpperBound,
+
-- * Version intervals view
asVersionIntervals,
VersionInterval,
@@ -147,7 +120,7 @@
-- This can be constructed using any unsatisfiable version range expression,
-- for example @> 1 && < 1@.
--
--- > withinRange v anyVersion = False
+-- > withinRange v noVersion = False
--
noVersion :: VersionRange
noVersion = IntersectVersionRanges (LaterVersion v) (EarlierVersion v)
@@ -237,9 +210,21 @@
{-# DEPRECATED betweenVersionsInclusive
"In practice this is not very useful because we normally use inclusive lower bounds and exclusive upper bounds" #-}
+-- | Given a version range, remove the highest upper bound. Example: @(>= 1 && <
+-- 3) || (>= 4 && < 5)@ is converted to @(>= 1 && < 3) || (>= 4)@.
+removeUpperBound :: VersionRange -> VersionRange
+removeUpperBound = fromVersionIntervals . relaxLastInterval . toVersionIntervals
+ where
+ relaxLastInterval (VersionIntervals intervals) =
+ VersionIntervals (relaxLastInterval' intervals)
+
+ relaxLastInterval' [] = []
+ relaxLastInterval' [(l,_)] = [(l, NoUpperBound)]
+ relaxLastInterval' (i:is) = i : relaxLastInterval' is
+
-- | Fold over the basic syntactic structure of a 'VersionRange'.
--
--- This provides a syntacic view of the expression defining the version range.
+-- This provides a syntactic view of the expression defining the version range.
-- The syntactic sugar @\">= v\"@, @\"<= v\"@ and @\"== v.*\"@ is presented
-- in terms of the other basic syntax.
--
@@ -493,7 +478,7 @@
-- | Directly construct a 'VersionIntervals' from a list of intervals.
--
-- Each interval must be non-empty. The sequence must be in increasing order
--- and no invervals may overlap or touch. If any of these conditions are not
+-- and no intervals may overlap or touch. If any of these conditions are not
-- satisfied the function returns @Nothing@.
--
mkVersionIntervals :: [VersionInterval] -> Maybe VersionIntervals
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,7 +1,8 @@
-Copyright (c) 2003-2008, Isaac Jones, Simon Marlow, Martin Sjögren,
+Copyright (c) 2003-2014, Isaac Jones, Simon Marlow, Martin Sjögren,
Bjorn Bringert, Krasimir Angelov,
Malcolm Wallace, Ross Patterson, Ian Lynagh,
- Duncan Coutts, Thomas Schilling
+ Duncan Coutts, Thomas Schilling,
+ Johan Tibell, Mikhail Glushenkov
All rights reserved.
Redistribution and use in source and binary forms, with or without
diff --git a/Language/Haskell/Extension.hs b/Language/Haskell/Extension.hs
--- a/Language/Haskell/Extension.hs
+++ b/Language/Haskell/Extension.hs
@@ -3,42 +3,13 @@
-- |
-- Module : Language.Haskell.Extension
-- Copyright : Isaac Jones 2003-2004
+-- License : BSD3
--
-- Maintainer : libraries@haskell.org
-- Portability : portable
--
-- Haskell language dialects and extensions
-{- 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 Isaac Jones 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. -}
-
module Language.Haskell.Extension (
Language(..),
knownLanguages,
@@ -721,7 +692,7 @@
]
-- NOTE: when adding deprecated extensions that have new alternatives
-- we must be careful to make sure that the deprecation messages are
--- valid. We must not recomend aliases that cannot be used with older
+-- valid. We must not recommend aliases that cannot be used with older
-- compilers, perhaps by adding support in Cabal to translate the new
-- name to the old one for older compilers. Otherwise we are in danger
-- of the scenario in ticket #689.
diff --git a/README b/README
--- a/README
+++ b/README
@@ -24,7 +24,7 @@
Installing as a user (no root or administrator access)
------------------------------------------------------
- ghc --make Setup
+ ghc -threaded --make Setup
./Setup configure --user
./Setup build
./Setup install
@@ -43,7 +43,7 @@
Installing as root / Administrator
----------------------------------
- ghc --make Setup
+ ghc -threaded --make Setup
./Setup configure
./Setup build
sudo ./Setup install
diff --git a/changelog b/changelog
--- a/changelog
+++ b/changelog
@@ -1,7 +1,30 @@
-*-change-log-*-
-1.18.1.7 Ryan Thomas January 2016
- * Cabal.cabal: change build-type to Simple.
+1.20.0.0 Johan Tibell April 2014
+ * Rewrite user guide
+ * Fix repl Ctrl+C handling
+ * Add haskell-suite compiler support
+ * Add __HADDOCK_VERSION__ define
+ * Allow specifying exact dependency version using hash
+ * Rename extra-html-files to extra-doc-files
+ * Add parallel build support for GHC 7.8 and later
+ * 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
+ ignored
+ * Add --enable-library-stripping
+ * Add command for freezing dependencies
+ * Allow repl to be used outside Cabal packages
+ * Add --require-sandbox
+ * Don't use --strip-unneeded on OS X or iOS
+ * Add new license-files field got additional licenses
+ * Fix if(solaris) on some Solaris versions
+ * Don't use -dylib-install-name on OS X with GHC > 7.8
+ * Add DragonFly as a known OS
+ * 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)
diff --git a/tests/Distribution/Compat/CreatePipe.hsc b/tests/Distribution/Compat/CreatePipe.hsc
deleted file mode 100644
--- a/tests/Distribution/Compat/CreatePipe.hsc
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# LANGUAGE CPP, ForeignFunctionInterface #-}
-module Distribution.Compat.CreatePipe (createPipe) where
-
-import System.IO (Handle)
-
-#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32))
-import System.Posix.IO (fdToHandle)
-import qualified System.Posix.IO as Posix
-#else
-# include /* for _close and _pipe */
-# include /* for _O_BINARY */
-import Control.Exception (onException)
-import Foreign.C.Error (throwErrnoIfMinus1_)
-import Foreign.C.Types (CInt(..), CUInt(..))
-import Foreign.Ptr (Ptr)
-import Foreign.Marshal.Array (allocaArray)
-import Foreign.Storable (peek, peekElemOff)
-import GHC.IO.FD (mkFD)
-import GHC.IO.Device (IODeviceType(Stream))
-import GHC.IO.Handle.FD (mkHandleFromFD)
-import System.IO (IOMode(ReadMode, WriteMode))
-#endif
-
-createPipe :: IO (Handle, Handle)
-#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32))
-createPipe = do
- (readfd, writefd) <- Posix.createPipe
- readh <- fdToHandle readfd
- writeh <- fdToHandle writefd
- return (readh, writeh)
-#else
-createPipe = do
- (readfd, writefd) <- allocaArray 2 $ \ pfds -> do
- throwErrnoIfMinus1_ "_pipe" $ c__pipe pfds 2 (#const _O_BINARY)
- readfd <- peek pfds
- writefd <- peekElemOff pfds 1
- return (readfd, writefd)
- (do readh <- fdToHandle readfd ReadMode
- writeh <- fdToHandle writefd WriteMode
- return (readh, writeh)) `onException` (close readfd >> close writefd)
-
-fdToHandle :: CInt -> IOMode -> IO Handle
-fdToHandle fd mode = do
- (fd', deviceType) <- mkFD fd mode (Just (Stream, 0, 0)) False False
- mkHandleFromFD fd' deviceType "" mode False Nothing
-
-close :: CInt -> IO ()
-close = throwErrnoIfMinus1_ "_close" . c__close
-
-foreign import ccall "io.h _pipe" c__pipe ::
- Ptr CInt -> CUInt -> CInt -> IO CInt
-
-foreign import ccall "io.h _close" c__close ::
- CInt -> IO CInt
-#endif
diff --git a/tests/PackageTests.hs b/tests/PackageTests.hs
--- a/tests/PackageTests.hs
+++ b/tests/PackageTests.hs
@@ -27,8 +27,8 @@
import PackageTests.PreProcess.Check
import PackageTests.TemplateHaskell.Check
import PackageTests.CMain.Check
+import PackageTests.DeterministicAr.Check
import PackageTests.EmptyLib.Check
-import PackageTests.Haddock.Check
import PackageTests.TestOptions.Check
import PackageTests.TestStanza.Check
import PackageTests.TestSuiteExeV10.Check
@@ -37,8 +37,7 @@
import Distribution.Compat.Exception (catchIO)
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)
import Distribution.Simple.Program.Db (requireProgram)
import Distribution.Simple.Utils (cabalVersion, die, withFileContents)
import Distribution.Text (display)
@@ -50,6 +49,7 @@
setCurrentDirectory)
import System.Environment (getEnv)
import System.FilePath (())
+import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout)
import Test.Framework (Test, TestName, defaultMain, testGroup)
import Test.Framework.Providers.HUnit (hUnitTestToTests)
import qualified Test.HUnit as HUnit
@@ -58,8 +58,8 @@
hunit :: TestName -> HUnit.Test -> Test
hunit name test = testGroup name $ hUnitTestToTests test
-tests :: Version -> PackageSpec -> FilePath -> FilePath -> Bool -> [Test]
-tests version inplaceSpec ghcPath ghcPkgPath runningOnTravis =
+tests :: Version -> PackageSpec -> FilePath -> FilePath -> [Test]
+tests version inplaceSpec ghcPath ghcPkgPath =
[ hunit "BuildDeps/SameDepsAllRound"
(PackageTests.BuildDeps.SameDepsAllRound.Check.suite ghcPath)
-- The two following tests were disabled by Johan Tibell as
@@ -86,26 +86,22 @@
, hunit "BenchmarkOptions" (PackageTests.BenchmarkOptions.Check.suite ghcPath)
, hunit "TemplateHaskell/vanilla"
(PackageTests.TemplateHaskell.Check.vanilla ghcPath)
+ , hunit "TemplateHaskell/profiling"
+ (PackageTests.TemplateHaskell.Check.profiling ghcPath)
, hunit "PathsModule/Executable"
(PackageTests.PathsModule.Executable.Check.suite ghcPath)
, hunit "PathsModule/Library" (PackageTests.PathsModule.Library.Check.suite ghcPath)
+ , hunit "DeterministicAr"
+ (PackageTests.DeterministicAr.Check.suite ghcPath ghcPkgPath)
, hunit "EmptyLib/emptyLib"
(PackageTests.EmptyLib.Check.emptyLib ghcPath)
- , hunit "Haddock" (PackageTests.Haddock.Check.suite ghcPath)
, hunit "BuildTestSuiteDetailedV09"
(PackageTests.BuildTestSuiteDetailedV09.Check.suite inplaceSpec ghcPath)
, hunit "OrderFlags"
(PackageTests.OrderFlags.Check.suite ghcPath)
+ , hunit "TemplateHaskell/dynamic"
+ (PackageTests.TemplateHaskell.Check.dynamic ghcPath)
] ++
- -- These tests are expected to fail on Travis because hvr's PPA GHCs don't
- -- include profiling and dynamic libs.
- (if not runningOnTravis
- then [ hunit "TemplateHaskell/profiling"
- (PackageTests.TemplateHaskell.Check.profiling ghcPath)
- , hunit "TemplateHaskell/dynamic"
- (PackageTests.TemplateHaskell.Check.dynamic ghcPath)
- ]
- else []) ++
-- These tests are only required to pass on cabal version >= 1.7
(if version >= Version [1, 7] []
then [ hunit "BuildDeps/TargetSpecificDeps1"
@@ -129,6 +125,10 @@
main :: IO ()
main = do
+ -- WORKAROUND: disable buffering on stdout to get streaming test logs
+ -- test providers _should_ do this themselves
+ hSetBuffering stdout NoBuffering
+
wd <- getCurrentDirectory
let dbFile = wd "dist/package.conf.inplace"
inplaceSpec = PackageSpec
@@ -142,27 +142,14 @@
lbi <- getPersistBuildConfig_ ("dist" "setup-config")
(ghc, _) <- requireProgram normal ghcProgram (withPrograms lbi)
(ghcPkg, _) <- requireProgram normal ghcPkgProgram (withPrograms lbi)
- (haddock, _) <- requireProgram normal haddockProgram (withPrograms lbi)
let ghcPath = programPath ghc
ghcPkgPath = programPath ghcPkg
- haddockPath = programPath haddock
putStrLn $ "Using ghc: " ++ ghcPath
putStrLn $ "Using ghc-pkg: " ++ ghcPkgPath
- putStrLn $ "Using haddock: " ++ haddockPath
setCurrentDirectory "tests"
- -- Are we running on Travis-CI?
- runningOnTravis <- checkRunningOnTravis
-- Create a shared Setup executable to speed up Simple tests
compileSetup "." ghcPath
- defaultMain (tests cabalVersion inplaceSpec
- ghcPath ghcPkgPath runningOnTravis)
-
--- | Is the test suite running on the Travis-CI build bot?
-checkRunningOnTravis :: IO Bool
-checkRunningOnTravis = fmap isJust (lookupEnv "CABAL_TEST_RUNNING_ON_TRAVIS")
- where
- lookupEnv :: String -> IO (Maybe String)
- lookupEnv name = (Just `fmap` getEnv name) `catchIO` const (return Nothing)
+ defaultMain (tests cabalVersion inplaceSpec ghcPath ghcPkgPath)
-- Like Distribution.Simple.Configure.getPersistBuildConfig but
-- doesn't check that the Cabal version matches, which it doesn't when
diff --git a/tests/PackageTests/DeterministicAr/Check.hs b/tests/PackageTests/DeterministicAr/Check.hs
new file mode 100644
--- /dev/null
+++ b/tests/PackageTests/DeterministicAr/Check.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module PackageTests.DeterministicAr.Check where
+
+import Control.Monad
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS8
+import Data.Char (isSpace)
+import Data.List
+import Data.Traversable
+import PackageTests.PackageTester
+import System.Exit
+import System.FilePath
+import System.IO
+import Test.HUnit (Assertion, Test (TestCase), assertFailure)
+
+-- Perhaps these should live in PackageTester.
+
+-- For a polymorphic @IO a@ rather than @Assertion = IO ()@.
+assertFailure' :: String -> IO a
+assertFailure' msg = assertFailure msg >> return {-unpossible!-}undefined
+
+ghcPkg_field :: String -> String -> FilePath -> IO [FilePath]
+ghcPkg_field libraryName fieldName ghcPkgPath = do
+ (cmd, exitCode, raw) <- run Nothing ghcPkgPath
+ ["--user", "field", libraryName, fieldName]
+ let output = filter ('\r' /=) raw -- Windows
+ -- copypasta of PackageTester.requireSuccess
+ unless (exitCode == ExitSuccess) . assertFailure $
+ "Command " ++ cmd ++ " failed.\n" ++ "output: " ++ output
+
+ let prefix = fieldName ++ ": "
+ case traverse (stripPrefix prefix) (lines output) of
+ Nothing -> assertFailure' $ "Command " ++ cmd ++ " failed: expected "
+ ++ show prefix ++ " prefix on every line.\noutput: " ++ output
+ Just fields -> return fields
+
+ghcPkg_field1 :: String -> String -> FilePath -> IO FilePath
+ghcPkg_field1 libraryName fieldName ghcPkgPath = do
+ fields <- ghcPkg_field libraryName fieldName ghcPkgPath
+ case fields of
+ [field] -> return field
+ _ -> assertFailure' $ "Command ghc-pkg field failed: "
+ ++ "output not a single line.\noutput: " ++ show fields
+
+------------------------------------------------------------------------
+
+this :: String
+this = "DeterministicAr"
+
+suite :: FilePath -> FilePath -> Test
+suite ghcPath ghcPkgPath = TestCase $ do
+ let dir = "PackageTests" this
+ let spec = PackageSpec dir []
+
+ unregister this ghcPkgPath
+ iResult <- cabal_install spec ghcPath
+ assertInstallSucceeded iResult
+
+ let distBuild = dir "dist" "build"
+ libdir <- ghcPkg_field1 this "library-dirs" ghcPkgPath
+ mapM_ checkMetadata [distBuild, libdir]
+ unregister this ghcPkgPath
+
+-- Almost a copypasta of Distribution.Simple.Program.Ar.wipeMetadata
+checkMetadata :: FilePath -> Assertion
+checkMetadata dir = withBinaryFile path ReadMode $ \ h -> do
+ hFileSize h >>= checkArchive h
+ where
+ path = dir "libHS" ++ this ++ "-0.a"
+
+ checkError msg = assertFailure' $
+ "PackageTests.DeterministicAr.checkMetadata: " ++ msg ++
+ " in " ++ path
+ archLF = "!\x0a" -- global magic, 8 bytes
+ x60LF = "\x60\x0a" -- header magic, 2 bytes
+ metadata = BS.concat
+ [ "0 " -- mtime, 12 bytes
+ , "0 " -- UID, 6 bytes
+ , "0 " -- GID, 6 bytes
+ , "0644 " -- mode, 8 bytes
+ ]
+ headerSize = 60
+
+ -- http://en.wikipedia.org/wiki/Ar_(Unix)#File_format_details
+ checkArchive :: Handle -> Integer -> IO ()
+ checkArchive h archiveSize = do
+ global <- BS.hGet h (BS.length archLF)
+ unless (global == archLF) $ checkError "Bad global header"
+ checkHeader (toInteger $ BS.length archLF)
+
+ where
+ checkHeader :: Integer -> IO ()
+ checkHeader offset = case compare offset archiveSize of
+ EQ -> return ()
+ GT -> checkError (atOffset "Archive truncated")
+ LT -> do
+ header <- BS.hGet h headerSize
+ unless (BS.length header == headerSize) $
+ checkError (atOffset "Short header")
+ let magic = BS.drop 58 header
+ unless (magic == x60LF) . checkError . atOffset $
+ "Bad magic " ++ show magic ++ " in header"
+
+ unless (metadata == BS.take 32 (BS.drop 16 header))
+ . checkError . atOffset $ "Metadata has changed"
+
+ let size = BS.take 10 $ BS.drop 48 header
+ objSize <- case reads (BS8.unpack size) of
+ [(n, s)] | all isSpace s -> return n
+ _ -> checkError (atOffset "Bad file size in header")
+
+ let nextHeader = offset + toInteger headerSize +
+ -- Odd objects are padded with an extra '\x0a'
+ if odd objSize then objSize + 1 else objSize
+ hSeek h AbsoluteSeek nextHeader
+ checkHeader nextHeader
+
+ where
+ atOffset msg = msg ++ " at offset " ++ show offset
diff --git a/tests/PackageTests/DeterministicAr/Lib.hs b/tests/PackageTests/DeterministicAr/Lib.hs
new file mode 100644
--- /dev/null
+++ b/tests/PackageTests/DeterministicAr/Lib.hs
@@ -0,0 +1,5 @@
+module Lib where
+
+dummy :: IO ()
+dummy = return ()
+
diff --git a/tests/PackageTests/DeterministicAr/my.cabal b/tests/PackageTests/DeterministicAr/my.cabal
new file mode 100644
--- /dev/null
+++ b/tests/PackageTests/DeterministicAr/my.cabal
@@ -0,0 +1,17 @@
+name: DeterministicAr
+version: 0
+license: BSD3
+cabal-version: >= 1.9.1
+author: Liyang HU
+stability: stable
+category: PackageTests
+build-type: Simple
+
+description:
+ Ensure our GNU ar -D emulation (#1537) works as advertised: check that
+ all metadata in the resulting .a archive match the default.
+
+Library
+ exposed-modules: Lib
+ build-depends: base
+
diff --git a/tests/PackageTests/Haddock/CPP.hs b/tests/PackageTests/Haddock/CPP.hs
deleted file mode 100644
--- a/tests/PackageTests/Haddock/CPP.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-module CPP where
-
-#define HIDING hiding
-#define NEEDLES needles
-
--- | For HIDING NEEDLES.
-data Haystack = Haystack
diff --git a/tests/PackageTests/Haddock/Check.hs b/tests/PackageTests/Haddock/Check.hs
deleted file mode 100644
--- a/tests/PackageTests/Haddock/Check.hs
+++ /dev/null
@@ -1,38 +0,0 @@
-module PackageTests.Haddock.Check (suite) where
-
-import Control.Monad (unless, when)
-import Data.List (isInfixOf)
-
-import System.FilePath (())
-import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
-import Test.HUnit (Assertion, Test (TestCase), assertFailure)
-
-import Distribution.Simple.Utils (withFileContents)
-import PackageTests.PackageTester
- (PackageSpec(..), assertHaddockSucceeded, cabal_haddock)
-
-this :: String
-this = "Haddock"
-
-suite :: FilePath -> Test
-suite ghcPath = TestCase $ do
- let dir = "PackageTests" this
- haddocksDir = dir "dist" "doc" "html" "Haddock"
- spec = PackageSpec dir []
-
- haddocksDirExists <- doesDirectoryExist haddocksDir
- when haddocksDirExists (removeDirectoryRecursive haddocksDir)
- hResult <- cabal_haddock spec [] ghcPath
- assertHaddockSucceeded hResult
-
- let docFiles = map (haddocksDir )
- ["CPP.html", "Literate.html", "NoCPP.html", "Simple.html"]
- mapM_ (assertFindInFile "For hiding needles.") docFiles
-
-assertFindInFile :: String -> FilePath -> Assertion
-assertFindInFile needle path =
- withFileContents path
- (\contents ->
- unless (needle `isInfixOf` contents)
- (assertFailure ("expected: " ++ needle ++ "\n" ++
- " in file: " ++ path)))
diff --git a/tests/PackageTests/Haddock/Literate.lhs b/tests/PackageTests/Haddock/Literate.lhs
deleted file mode 100644
--- a/tests/PackageTests/Haddock/Literate.lhs
+++ /dev/null
@@ -1,4 +0,0 @@
-> module Literate where
-
-> -- | For hiding needles.
-> data Haystack = Haystack
diff --git a/tests/PackageTests/Haddock/NoCPP.hs b/tests/PackageTests/Haddock/NoCPP.hs
deleted file mode 100644
--- a/tests/PackageTests/Haddock/NoCPP.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module NoCPP (Haystack) where
-
--- | For hiding needles.
-data Haystack = Haystack
-
--- | Causes a build failure if the CPP language extension is enabled.
-stringGap = "Foo\
-\Bar"
diff --git a/tests/PackageTests/Haddock/Simple.hs b/tests/PackageTests/Haddock/Simple.hs
deleted file mode 100644
--- a/tests/PackageTests/Haddock/Simple.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-module Simple where
-
--- | For hiding needles.
-data Haystack = Haystack
diff --git a/tests/PackageTests/Haddock/my.cabal b/tests/PackageTests/Haddock/my.cabal
deleted file mode 100644
--- a/tests/PackageTests/Haddock/my.cabal
+++ /dev/null
@@ -1,16 +0,0 @@
-name: Haddock
-version: 0.1
-license: BSD3
-author: Iain Nicol
-stability: stable
-category: PackageTests
-build-type: Simple
-Cabal-version: >= 1.2
-
-description:
- Check that Cabal successfully invokes Haddock.
-
-Library
- exposed-modules: CPP, Literate, NoCPP, Simple
- other-extensions: CPP
- build-depends: base
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
@@ -4,8 +4,10 @@
import PackageTests.PackageTester
import System.FilePath
import Control.Exception
-import Prelude hiding (catch)
+#if !MIN_VERSION_base(4,6,0)
+import Prelude hiding (catch)
+#endif
suite :: FilePath -> Test
suite ghcPath = TestCase $ do
diff --git a/tests/PackageTests/PackageTester.hs b/tests/PackageTests/PackageTester.hs
--- a/tests/PackageTests/PackageTester.hs
+++ b/tests/PackageTests/PackageTester.hs
@@ -10,7 +10,6 @@
-- * Running cabal commands
, cabal_configure
, cabal_build
- , cabal_haddock
, cabal_test
, cabal_bench
, cabal_install
@@ -21,7 +20,6 @@
-- * Test helpers
, assertBuildSucceeded
, assertBuildFailed
- , assertHaddockSucceeded
, assertTestSucceeded
, assertInstallSucceeded
, assertOutputContains
@@ -56,7 +54,6 @@
data Success = Failure
| ConfigureSuccess
| BuildSuccess
- | HaddockSuccess
| InstallSuccess
| TestSuccess
| BenchSuccess
@@ -115,22 +112,6 @@
record spec res
return res
-cabal_haddock :: PackageSpec -> [String] -> FilePath -> IO Result
-cabal_haddock spec extraArgs ghcPath = do
- res <- doCabalHaddock spec extraArgs ghcPath
- record spec res
- return res
-
-doCabalHaddock :: PackageSpec -> [String] -> FilePath -> IO Result
-doCabalHaddock spec extraArgs ghcPath = do
- configResult <- doCabalConfigure spec ghcPath
- if successful configResult
- then do
- 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]
@@ -250,12 +231,6 @@
assertBuildFailed result = when (successful result) $
assertFailure $
"expected: \'setup build\' should fail\n" ++
- " output: " ++ outputText result
-
-assertHaddockSucceeded :: Result -> Assertion
-assertHaddockSucceeded result = unless (successful result) $
- assertFailure $
- "expected: \'setup haddock\' should succeed\n" ++
" output: " ++ outputText result
assertTestSucceeded :: Result -> Assertion
diff --git a/tests/README b/tests/README
--- a/tests/README
+++ b/tests/README
@@ -4,7 +4,7 @@
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 utilites for calling the stages of Cabal's build
+`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.
diff --git a/tests/UnitTests.hs b/tests/UnitTests.hs
--- a/tests/UnitTests.hs
+++ b/tests/UnitTests.hs
@@ -2,6 +2,7 @@
( main
) where
+import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout)
import Test.Framework
import qualified UnitTests.Distribution.Compat.ReadP
@@ -13,4 +14,8 @@
]
main :: IO ()
-main = defaultMain tests
+main = do
+ -- WORKAROUND: disable buffering on stdout to get streaming test logs
+ -- test providers _should_ do this themselves
+ hSetBuffering stdout NoBuffering
+ defaultMain tests
diff --git a/tests/UnitTests/Distribution/Compat/ReadP.hs b/tests/UnitTests/Distribution/Compat/ReadP.hs
--- a/tests/UnitTests/Distribution/Compat/ReadP.hs
+++ b/tests/UnitTests/Distribution/Compat/ReadP.hs
@@ -8,7 +8,7 @@
-- Portability : portable
--
-- This code was originally in Distribution.Compat.ReadP. Please see that file
--- for provenace. The tests have been integrated into the test framework.
+-- for provenance. The tests have been integrated into the test framework.
-- Some properties cannot be tested, as they hold over arbitrary ReadP values,
-- and we don't have a good Arbitrary instance (nor Show instance) for ReadP.
--
@@ -151,4 +151,3 @@
evenChar :: Char -> Bool
evenChar = even . fromEnum
-