------------------------------------------------------------------------------- |-- Module : Distribution.Simple.SrcDist-- Copyright : Simon Marlow 2004---- Maintainer : cabal-devel@haskell.org-- Portability : portable---- This handles the @sdist@ command. The module exports an 'sdist' action but-- also some of the phases that make it up so that other tools can use just the-- bits they need. In particular the preparation of the tree of files to go-- into the source tarball is separated from actually building the source-- tarball.---- The 'createArchive' action uses the external @tar@ program and assumes that-- 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.moduleDistribution.Simple.SrcDist(-- * The top level actionsdist,-- ** Parts of 'sdist'printPackageProblems,prepareTree,createArchive,-- ** SnaphotsprepareSnapshotTree,snapshotPackage,snapshotVersion,dateToSnapshotNumber,)whereimportDistribution.PackageDescription(PackageDescription(..),BuildInfo(..),Executable(..),Library(..))importDistribution.PackageDescription.Check(PackageCheck(..),checkConfiguredPackage,checkPackageFiles)importDistribution.Package(PackageIdentifier(pkgVersion),Package(..),packageVersion)importDistribution.ModuleName(ModuleName)importqualifiedDistribution.ModuleNameasModuleNameimportDistribution.Version(Version(versionBranch),VersionRange(AnyVersion))importDistribution.Simple.Utils(createDirectoryIfMissingVerbose,withUTF8FileContents,writeUTF8File,copyFiles,copyFileVerbose,findFile,findFileWithExtension,matchFileGlob,withTempDirectory,defaultPackageDesc,die,warn,notice,setupMessage)importDistribution.Simple.Setup(SDistFlags(..),fromFlag)importDistribution.Simple.PreProcess(PPSuffixHandler,ppSuffixes,preprocessSources)importDistribution.Simple.LocalBuildInfo(LocalBuildInfo(..))importDistribution.Simple.BuildPaths(autogenModuleName)importDistribution.Simple.Program(defaultProgramConfiguration,requireProgram,rawSystemProgram,tarProgram)importDistribution.Text(display)importControl.Monad(when,unless)importData.Char(toLower)importData.List(partition,isPrefixOf)importData.Maybe(isNothing,catMaybes)importSystem.Time(getClockTime,toCalendarTime,CalendarTime(..))importSystem.Directory(doesFileExist,doesDirectoryExist)importDistribution.Verbosity(Verbosity)importSystem.FilePath((</>),(<.>),takeDirectory,dropExtension,isAbsolute)-- |Create a source distribution.sdist::PackageDescription-- ^information from the tarball->MaybeLocalBuildInfo-- ^Information from configure->SDistFlags-- ^verbosity & snapshot->(FilePath->FilePath)-- ^build prefix (temp dir)->[PPSuffixHandler]-- ^ extra preprocessors (includes suffixes)->IO()sdistpkgmb_lbiflagsmkTmpDirpps=doletdistPref=fromFlag$sDistDistPrefflagstargetPref=distPreftmpDir=mkTmpDirdistPref-- do some QAprintPackageProblemsverbositypkgexists<-doesDirectoryExisttmpDirwhenexists$die$"Source distribution already in place. please move or remove: "++tmpDirwhen(isNothingmb_lbi)$warnverbosity"Cannot run preprocessors. Run 'configure' command first."withTempDirectoryverbositytmpDir$dodate<-toCalendarTime=<<getClockTimeletpkg'|snapshot=snapshotPackagedatepkg|otherwise=pkgsetupMessageverbosity"Building source dist for"(packageIdpkg')ifsnapshotthenprepareSnapshotTreeverbositypkg'mb_lbidistPreftmpDirppselseprepareTreeverbositypkg'mb_lbidistPreftmpDirppstargzFile<-createArchiveverbositypkg'mb_lbitmpDirtargetPrefnoticeverbosity$"Source tarball created: "++targzFilewhereverbosity=fromFlag(sDistVerbosityflags)snapshot=fromFlag(sDistSnapshotflags)-- |Prepare a directory tree of source files.prepareTree::Verbosity-- ^verbosity->PackageDescription-- ^info from the cabal file->MaybeLocalBuildInfo->FilePath-- ^dist dir->FilePath-- ^source tree to populate->[PPSuffixHandler]-- ^extra preprocessors (includes suffixes)->IOFilePath-- ^the name of the dir created and populatedprepareTreeverbositypkg_descr0mb_lbidistPreftmpDirpps=dolettargetDir=tmpDir</>tarBallNamepkg_descrcreateDirectoryIfMissingVerboseverbosityTruetargetDir-- maybe move the library files into placewithLib$\Library{exposedModules=modules,libBuildInfo=libBi}->prepareDirverbositypkg_descrdistPreftargetDirppsmoduleslibBi-- move the executables into placewithExe$\Executable{modulePath=mainPath,buildInfo=exeBi}->doprepareDirverbositypkg_descrdistPreftargetDirpps[]exeBisrcMainFile<-doppFile<-findFileWithExtension(ppSuffixespps)(hsSourceDirsexeBi)(dropExtensionmainPath)caseppFileofNothing->findFile(hsSourceDirsexeBi)mainPathJustpp->returnppcopyFileToverbositytargetDirsrcMainFileflipmapM_(dataFilespkg_descr)$\filename->dofiles<-matchFileGlob(dataDirpkg_descr</>filename)letdir=takeDirectory(dataDirpkg_descr</>filename)createDirectoryIfMissingVerboseverbosityTrue(targetDir</>dir)sequence_[copyFileVerboseverbosityfile(targetDir</>file)|file<-files]when(not(null(licenseFilepkg_descr)))$copyFileToverbositytargetDir(licenseFilepkg_descr)flipmapM_(extraSrcFilespkg_descr)$\fpath->dofiles<-matchFileGlobfpathsequence_[copyFileToverbositytargetDirfile|file<-files]-- copy the install-include fileswithLib$\l->doletlbi=libBuildInfolrelincdirs=".":filter(not.isAbsolute)(includeDirslbi)incs<-mapM(findIncrelincdirs)(installIncludeslbi)flipmapM_incs$\(_,fpath)->copyFileToverbositytargetDirfpath-- if the package was configured then we can run platform independent-- pre-processors and include those generated filescasemb_lbiofJustlbi|not(nullpps)->preprocessSourcespkg_descr(lbi{buildDir=targetDir</>buildDirlbi})Trueverbositypps_->return()-- setup isn't listed in the description file.hsExists<-doesFileExist"Setup.hs"lhsExists<-doesFileExist"Setup.lhs"ifhsExiststhencopyFileToverbositytargetDir"Setup.hs"elseiflhsExiststhencopyFileToverbositytargetDir"Setup.lhs"elsewriteUTF8File(targetDir</>"Setup.hs")$unlines["import Distribution.Simple","main = defaultMain"]-- the description file itselfdescFile<-defaultPackageDescverbositycopyFileVerboseverbositydescFile(targetDir</>descFile)returntargetDirwherepkg_descr=mapAllBuildInfofilterAutogenModulepkg_descr0filterAutogenModulebi=bi{otherModules=filter(/=autogenModule)(otherModulesbi)}autogenModule=autogenModuleNamepkg_descr0findInc[]f=die("can't find include file "++f)findInc(d:ds)f=doletpath=(d</>f)b<-doesFileExistpathifbthenreturn(f,path)elsefindIncdsf-- We have to deal with all libs and executables, so we have local-- versions of these functions that ignore the 'buildable' attribute:withLibaction=maybe(return())action(librarypkg_descr)withExeaction=mapM_action(executablespkg_descr)-- | Prepare a directory tree of source files for a snapshot version.-- It is expected that the appropriate snapshot version has already been set-- in the package description, eg using 'snapshotPackage' or 'snapshotVersion'.--prepareSnapshotTree::Verbosity-- ^verbosity->PackageDescription-- ^info from the cabal file->MaybeLocalBuildInfo->FilePath-- ^dist dir->FilePath-- ^source tree to populate->[PPSuffixHandler]-- ^extra preprocessors (includes suffixes)->IOFilePath-- ^the resulting temp dirprepareSnapshotTreeverbositypkgmb_lbidistPreftmpDirpps=dotargetDir<-prepareTreeverbositypkgmb_lbidistPreftmpDirppsoverwriteSnapshotPackageDesc(packageVersionpkg)targetDirreturntargetDirwhereoverwriteSnapshotPackageDescversiontargetDir=do-- We could just writePackageDescription targetDescFile pkg_descr,-- but that would lose comments and formatting.descFile<-defaultPackageDescverbositywithUTF8FileContentsdescFile$writeUTF8File(targetDir</>descFile).unlines.map(replaceVersionversion).linesreplaceVersion::Version->String->StringreplaceVersionversionline|"version:"`isPrefixOf`maptoLowerline="version: "++displayversion|otherwise=line-- | Modifies a 'PackageDescription' by appending a snapshot number-- corresponding to the given date.--snapshotPackage::CalendarTime->PackageDescription->PackageDescriptionsnapshotPackagedatepkg=pkg{package=pkgid{pkgVersion=snapshotVersiondate(pkgVersionpkgid)}}wherepkgid=packageIdpkg-- | Modifies a 'Version' by appending a snapshot number corresponding-- to the given date.--snapshotVersion::CalendarTime->Version->VersionsnapshotVersiondateversion=version{versionBranch=versionBranchversion++[dateToSnapshotNumberdate]}-- | Given a date produce a corresponding integer representation.-- For example given a date @18/03/2008@ produce the number @20080318@.--dateToSnapshotNumber::CalendarTime->IntdateToSnapshotNumberdate=year*10000+month*100+daywhereyear=ctYeardatemonth=fromEnum(ctMonthdate)+1day=ctDaydate-- |Create an archive from a tree of source files, and clean up the tree.createArchive::Verbosity-- ^verbosity->PackageDescription-- ^info from cabal file->MaybeLocalBuildInfo-- ^info from configure->FilePath-- ^source tree to archive->FilePath-- ^name of archive to create->IOFilePathcreateArchiveverbositypkg_descrmb_lbitmpDirtargetPref=dolettarBallFilePath=targetPref</>tarBallNamepkg_descr<.>"tar.gz"(tarProg,_)<-requireProgramverbositytarProgramAnyVersion(maybedefaultProgramConfigurationwithProgramsmb_lbi)-- Hmm: I could well be skating on thinner ice here by using the -C option (=> GNU tar-specific?)-- [The prev. solution used pipes and sub-command sequences to set up the paths correctly,-- which is problematic in a Windows setting.]rawSystemProgramverbositytarProg["-C",tmpDir,"-czf",tarBallFilePath,tarBallNamepkg_descr]returntarBallFilePath-- |Move the sources into place based on buildInfoprepareDir::Verbosity-- ^verbosity->PackageDescription-- ^info from the cabal file->FilePath-- ^dist dir->FilePath-- ^TargetPrefix->[PPSuffixHandler]-- ^ extra preprocessors (includes suffixes)->[ModuleName]-- ^Exposed modules->BuildInfo->IO()prepareDirverbosity_pkg_distPrefinPrefppsmodulesbi=doletsearchDirs=hsSourceDirsbisources<-sequence[letfile=ModuleName.toFilePathmodule_infindFileWithExtensionsuffixessearchDirsfile>>=maybe(notFoundmodule_)return|module_<-modules++otherModulesbi]bootFiles<-sequence[letfile=ModuleName.toFilePathmodule_infindFileWithExtension["hs-boot"](hsSourceDirsbi)file|module_<-modules++otherModulesbi]letallSources=sources++catMaybesbootFiles++cSourcesbicopyFilesverbosityinPref(zip(repeat[])allSources)wheresuffixes=ppSuffixespps++["hs","lhs"]notFoundm=die$"Error: Could not find module: "++displaym++" with any suffix: "++showsuffixescopyFileTo::Verbosity->FilePath->FilePath->IO()copyFileToverbositydirfile=dolettargetFile=dir</>filecreateDirectoryIfMissingVerboseverbosityTrue(takeDirectorytargetFile)copyFileVerboseverbosityfiletargetFileprintPackageProblems::Verbosity->PackageDescription->IO()printPackageProblemsverbositypkg_descr=doioChecks<-checkPackageFilespkg_descr"."letpureChecks=checkConfiguredPackagepkg_descrisDistError(PackageDistSuspicious_)=FalseisDistError_=True(errors,warnings)=partitionisDistError(pureChecks++ioChecks)unless(nullerrors)$noticeverbosity$"Distribution quality errors:\n"++unlines(mapexplanationerrors)unless(nullwarnings)$noticeverbosity$"Distribution quality warnings:\n"++unlines(mapexplanationwarnings)unless(nullerrors)$noticeverbosity"Note: the public hackage server would reject this package."-------------------------------------------------------------- | The name of the tarball without extension--tarBallName::PackageDescription->StringtarBallName=display.packageIdmapAllBuildInfo::(BuildInfo->BuildInfo)->(PackageDescription->PackageDescription)mapAllBuildInfofpkg=pkg{library=fmapmapLibBi(librarypkg),executables=fmapmapExeBi(executablespkg)}wheremapLibBilib=lib{libBuildInfo=f(libBuildInfolib)}mapExeBiexe=exe{buildInfo=f(buildInfoexe)}