Cabal 1.18.1.7 → 1.20.0.0
raw patch · 84 files changed
+2762/−2820 lines, 84 filesdep ~QuickCheckdep ~deepseqdep ~timebuild-type:Custom
Dependency ranges changed: QuickCheck, deepseq, time
Files
- Cabal.cabal +20/−23
- Distribution/Compat/CopyFile.hs +31/−3
- Distribution/Compat/CreatePipe.hs +75/−0
- Distribution/Compat/ReadP.hs +0/−3
- Distribution/Compat/TempFile.hs +5/−5
- Distribution/Compiler.hs +3/−30
- Distribution/InstalledPackageInfo.hs +2/−1
- Distribution/License.hs +79/−73
- Distribution/Make.hs +2/−31
- Distribution/ModuleName.hs +1/−30
- Distribution/Package.hs +1/−30
- Distribution/PackageDescription.hs +5/−34
- Distribution/PackageDescription/Check.hs +35/−64
- Distribution/PackageDescription/Configuration.hs +11/−37
- Distribution/PackageDescription/Parse.hs +49/−49
- Distribution/PackageDescription/PrettyPrint.hs +8/−48
- Distribution/ParseUtils.hs +65/−55
- Distribution/ReadE.hs +1/−31
- Distribution/Simple.hs +4/−33
- Distribution/Simple/Bench.hs +1/−30
- Distribution/Simple/Build.hs +67/−85
- Distribution/Simple/Build/Macros.hs +45/−16
- Distribution/Simple/BuildPaths.hs +1/−30
- Distribution/Simple/CCompiler.hs +1/−1
- Distribution/Simple/Command.hs +18/−38
- Distribution/Simple/Compiler.hs +19/−32
- Distribution/Simple/Configure.hs +152/−64
- Distribution/Simple/GHC.hs +141/−161
- Distribution/Simple/GHC/IPI641.hs +1/−30
- Distribution/Simple/GHC/IPI642.hs +1/−30
- Distribution/Simple/Haddock.hs +206/−164
- Distribution/Simple/HaskellSuite.hs +222/−0
- Distribution/Simple/Hpc.hs +1/−30
- Distribution/Simple/Hugs.hs +4/−32
- Distribution/Simple/Install.hs +10/−33
- Distribution/Simple/InstallDirs.hs +9/−38
- Distribution/Simple/JHC.hs +4/−34
- Distribution/Simple/LHC.hs +11/−59
- Distribution/Simple/LocalBuildInfo.hs +3/−31
- Distribution/Simple/NHC.hs +9/−37
- Distribution/Simple/PackageIndex.hs +5/−5
- Distribution/Simple/PreProcess.hs +61/−73
- Distribution/Simple/Program.hs +5/−6
- Distribution/Simple/Program/Ar.hs +108/−10
- Distribution/Simple/Program/Builtin.hs +38/−6
- Distribution/Simple/Program/Db.hs +22/−18
- Distribution/Simple/Program/Find.hs +17/−11
- Distribution/Simple/Program/GHC.hs +30/−15
- Distribution/Simple/Program/Strip.hs +58/−0
- Distribution/Simple/Program/Types.hs +2/−2
- Distribution/Simple/Register.hs +8/−34
- Distribution/Simple/Setup.hs +217/−156
- Distribution/Simple/SrcDist.hs +5/−37
- Distribution/Simple/Test.hs +29/−444
- Distribution/Simple/Test/ExeV10.hs +146/−0
- Distribution/Simple/Test/LibV09.hs +239/−0
- Distribution/Simple/Test/Log.hs +161/−0
- Distribution/Simple/UHC.hs +8/−36
- Distribution/Simple/UserHooks.hs +2/−31
- Distribution/Simple/Utils.hs +49/−49
- Distribution/System.hs +6/−6
- Distribution/TestSuite.hs +1/−30
- Distribution/Verbosity.hs +2/−32
- Distribution/Version.hs +19/−34
- LICENSE +3/−2
- Language/Haskell/Extension.hs +2/−31
- README +2/−2
- changelog +25/−2
- tests/Distribution/Compat/CreatePipe.hsc +0/−55
- tests/PackageTests.hs +16/−29
- tests/PackageTests/DeterministicAr/Check.hs +120/−0
- tests/PackageTests/DeterministicAr/Lib.hs +5/−0
- tests/PackageTests/DeterministicAr/my.cabal +17/−0
- tests/PackageTests/Haddock/CPP.hs +0/−9
- tests/PackageTests/Haddock/Check.hs +0/−38
- tests/PackageTests/Haddock/Literate.lhs +0/−4
- tests/PackageTests/Haddock/NoCPP.hs +0/−8
- tests/PackageTests/Haddock/Simple.hs +0/−4
- tests/PackageTests/Haddock/my.cabal +0/−16
- tests/PackageTests/OrderFlags/Check.hs +3/−1
- tests/PackageTests/PackageTester.hs +0/−25
- tests/README +1/−1
- tests/UnitTests.hs +6/−1
- tests/UnitTests/Distribution/Compat/ReadP.hs +1/−2
Cabal.cabal view
@@ -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,
Distribution/Compat/CopyFile.hs view
@@ -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
+ Distribution/Compat/CreatePipe.hs view
@@ -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
Distribution/Compat/ReadP.hs view
@@ -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']))---
Distribution/Compat/TempFile.hs view
@@ -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 = '\\'
Distribution/Compiler.hs view
@@ -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))
Distribution/InstalledPackageInfo.hs view
@@ -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(..) )
Distribution/License.hs view
@@ -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 <http://www.opensource.org/>.+-- 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+-- <https://en.wikipedia.org/wiki/License_compatibility licensing conflicts>,+-- and to deter+-- <https://en.wikipedia.org/wiki/License_proliferation license proliferation>. ----- 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+-- <http://www.haskell.org/cabal/users-guide/developing-packages.html#package-descriptions Cabal users guide>.+--+-- = Additional resources+--+-- The following websites provide information about free and open source+-- software licenses:+--+-- * <http://www.opensource.org The Open Source Initiative (OSI)>+--+-- * <https://www.fsf.org The Free Software Foundation (FSF)>+--+-- = 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,+ -- <https://www.gnu.org/licenses/old-licenses/gpl-2.0.html version 2> or+ -- <https://www.gnu.org/licenses/gpl.html version 3>. GPL (Maybe Version) - -- | GNU Affero General Public License+ -- | <https://www.gnu.org/licenses/agpl.html GNU Affero General Public License, version 3>. | AGPL (Maybe Version) - -- | Lesser GPL, Less restrictive than GPL, useful for libraries.+ -- | GNU Lesser General Public License,+ -- <https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html version 2.1> or+ -- <https://www.gnu.org/licenses/lgpl.html version 3>. | LGPL (Maybe Version) - -- | 3-clause BSD license, newer, no advertising clause. Very free license.+ -- | <http://www.opensource.org/licenses/bsd-license 2-clause BSD license>.+ | BSD2++ -- | <http://www.opensource.org/licenses/bsd-3-clause 3-clause BSD license>. | BSD3 - -- | 4-clause BSD license, older, with advertising clause. You almost- -- certainly want to use the BSD3 license instead.+ -- | <http://directory.fsf.org/wiki/License:BSD_4Clause 4-clause BSD license>.+ -- 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.+ -- | <http://www.opensource.org/licenses/MIT MIT license>. | MIT - -- | The Apache License. Version 2.0 is the current version,- -- previous versions are considered historical.+ -- | <https://www.mozilla.org/MPL/ Mozilla Public License, version 2.0>.+ | MPL Version + -- | <https://www.apache.org/licenses/ Apache License, version 2.0>. | 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
Distribution/Make.hs view
@@ -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,
Distribution/ModuleName.hs view
@@ -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,
Distribution/Package.hs view
@@ -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
Distribution/PackageDescription.hs view
@@ -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
Distribution/PackageDescription/Check.hs view
@@ -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
Distribution/PackageDescription/Configuration.hs view
@@ -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] [])
Distribution/PackageDescription/Parse.hs view
@@ -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
Distribution/PackageDescription/PrettyPrint.hs view
@@ -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
Distribution/ParseUtils.hs view
@@ -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
Distribution/ReadE.hs view
@@ -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
Distribution/Simple.hs view
@@ -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),
Distribution/Simple/Bench.hs view
@@ -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
Distribution/Simple/Build.hs view
@@ -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."
Distribution/Simple/Build/Macros.hs view
@@ -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
Distribution/Simple/BuildPaths.hs view
@@ -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,
Distribution/Simple/CCompiler.hs view
@@ -59,7 +59,7 @@ | ObjectiveC | CPlusPlus | ObjectiveCPlusPlus- deriving (Show)+ deriving (Eq, Show) instance Monoid CDialect where mempty = C
Distribution/Simple/Command.hs view
@@ -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
Distribution/Simple/Compiler.hs view
@@ -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
Distribution/Simple/Configure.hs view
@@ -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)
Distribution/Simple/GHC.hs view
@@ -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"
Distribution/Simple/GHC/IPI641.hs view
@@ -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,
Distribution/Simple/GHC/IPI642.hs view
@@ -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,
Distribution/Simple/Haddock.hs view
@@ -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,
+ Distribution/Simple/HaskellSuite.hs view
@@ -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
Distribution/Simple/Hpc.hs view
@@ -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
Distribution/Simple/Hugs.hs view
@@ -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'')
Distribution/Simple/Install.hs view
@@ -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"
Distribution/Simple/InstallDirs.hs view
@@ -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')
Distribution/Simple/JHC.hs view
@@ -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')
Distribution/Simple/LHC.hs view
@@ -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
Distribution/Simple/LocalBuildInfo.hs view
@@ -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)
Distribution/Simple/NHC.hs view
@@ -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'''')
Distribution/Simple/PackageIndex.hs view
@@ -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.
Distribution/Simple/PreProcess.hs view
@@ -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 }
Distribution/Simple/Program.hs view
@@ -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" ---------------------
Distribution/Simple/Program/Ar.hs view
@@ -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 = "!<arch>\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
Distribution/Simple/Program/Builtin.hs view
@@ -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"
Distribution/Simple/Program/Db.hs view
@@ -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
Distribution/Simple/Program/Find.hs view
@@ -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
Distribution/Simple/Program/GHC.hs view
@@ -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,
+ Distribution/Simple/Program/Strip.hs view
@@ -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"]
Distribution/Simple/Program/Types.hs view
@@ -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 }
Distribution/Simple/Register.hs view
@@ -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
Distribution/Simple/Setup.hs view
@@ -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
Distribution/Simple/SrcDist.hs view
@@ -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
Distribution/Simple/Test.hs view
@@ -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
+ Distribution/Simple/Test/ExeV10.hs view
@@ -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)]
+ Distribution/Simple/Test/LibV09.hs view
@@ -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
+ Distribution/Simple/Test/Log.hs view
@@ -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"
Distribution/Simple/UHC.hs view
@@ -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"
Distribution/Simple/UserHooks.hs view
@@ -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 (),
Distribution/Simple/Utils.hs view
@@ -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 -- ^<pkgname>.cabal+findPackageDesc :: FilePath -- ^Where to look+ -> IO (Either String FilePath) -- ^<pkgname>.cabal findPackageDesc dir = do files <- getDirectoryContents dir -- to make sure we do not mistake a ~/.cabal/ dir for a <pkgname>.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 <pkgname>.cabal"+ noDesc :: String+ noDesc = "No cabal file found.\n"+ ++ "Please create a package description file <pkgname>.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 -- ------------------------------------------------------------
Distribution/System.hs view
@@ -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"]
Distribution/TestSuite.hs view
@@ -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(..)
Distribution/Verbosity.hs view
@@ -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
Distribution/Version.hs view
@@ -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
LICENSE view
@@ -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
Language/Haskell/Extension.hs view
@@ -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.
README view
@@ -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
changelog view
@@ -1,7 +1,30 @@ -*-change-log-*- -1.18.1.7 Ryan Thomas <ryan@ryant.org> January 2016- * Cabal.cabal: change build-type to Simple.+1.20.0.0 Johan Tibell <johan.tibell@gmail.com> 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)
− tests/Distribution/Compat/CreatePipe.hsc
@@ -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 <io.h> /* for _close and _pipe */-# include <fcntl.h> /* 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
tests/PackageTests.hs view
@@ -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
+ tests/PackageTests/DeterministicAr/Check.hs view
@@ -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 = "!<arch>\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
+ tests/PackageTests/DeterministicAr/Lib.hs view
@@ -0,0 +1,5 @@+module Lib where++dummy :: IO ()+dummy = return ()+
+ tests/PackageTests/DeterministicAr/my.cabal view
@@ -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+
− tests/PackageTests/Haddock/CPP.hs
@@ -1,9 +0,0 @@-{-# LANGUAGE CPP #-}--module CPP where--#define HIDING hiding-#define NEEDLES needles---- | For HIDING NEEDLES.-data Haystack = Haystack
− tests/PackageTests/Haddock/Check.hs
@@ -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)))
− tests/PackageTests/Haddock/Literate.lhs
@@ -1,4 +0,0 @@-> module Literate where--> -- | For hiding needles.-> data Haystack = Haystack
− tests/PackageTests/Haddock/NoCPP.hs
@@ -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"
− tests/PackageTests/Haddock/Simple.hs
@@ -1,4 +0,0 @@-module Simple where---- | For hiding needles.-data Haystack = Haystack
− tests/PackageTests/Haddock/my.cabal
@@ -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
tests/PackageTests/OrderFlags/Check.hs view
@@ -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
tests/PackageTests/PackageTester.hs view
@@ -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
tests/README view
@@ -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.
tests/UnitTests.hs view
@@ -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
tests/UnitTests/Distribution/Compat/ReadP.hs view
@@ -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-