module Distribution.Simple.SrcDist (
sdist
,createArchive
,prepareTree
,tarBallName
,copyFileTo
#ifdef DEBUG
,hunitTests
#endif
) where
import Distribution.PackageDescription
(PackageDescription(..), BuildInfo(..), Executable(..), Library(..),
withLib, withExe, setupMessage)
import Distribution.Package (showPackageId, PackageIdentifier(pkgVersion))
import Distribution.Version (Version(versionBranch), VersionRange(AnyVersion))
import Distribution.Simple.Utils (createDirectoryIfMissingVerbose,
smartCopySources, die, warn, notice,
findPackageDesc, findFile, findFileWithExtension,
copyFileVerbose)
import Distribution.Simple.Setup (SDistFlags(..))
import Distribution.Simple.PreProcess (PPSuffixHandler, ppSuffixes, preprocessSources)
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
import Distribution.Simple.Program ( defaultProgramConfiguration, requireProgram,
rawSystemProgram, tarProgram )
#ifndef __NHC__
import Control.Exception (finally)
#endif
import Control.Monad(when)
import Data.Char (isSpace, toLower)
import Data.List (isPrefixOf)
import System.Time (getClockTime, toCalendarTime, CalendarTime(..))
import Distribution.Compat.Directory (doesFileExist, doesDirectoryExist,
getCurrentDirectory, removeDirectoryRecursive)
import Distribution.Verbosity
import System.FilePath ((</>), takeDirectory, isAbsolute, dropExtension)
#ifdef DEBUG
import Test.HUnit (Test)
#endif
#ifdef __NHC__
finally :: IO a -> IO b -> IO a
x `finally` y = do { a <- x; y; return a }
#endif
sdist :: PackageDescription
-> Maybe LocalBuildInfo
-> SDistFlags
-> FilePath
-> FilePath
-> [PPSuffixHandler]
-> IO ()
sdist pkg_descr_orig mb_lbi (SDistFlags snapshot verbosity) tmpDir targetPref pps = do
time <- getClockTime
ct <- toCalendarTime time
let date = ctYear ct*10000 + (fromEnum (ctMonth ct) + 1)*100 + ctDay ct
let pkg_descr
| snapshot = updatePackage (updatePkgVersion
(updateVersionBranch (++ [date]))) pkg_descr_orig
| otherwise = pkg_descr_orig
prepareTree pkg_descr verbosity mb_lbi snapshot tmpDir pps date
createArchive pkg_descr verbosity mb_lbi tmpDir targetPref
return ()
where
updatePackage f pd = pd { package = f (package pd) }
updatePkgVersion f pkg = pkg { pkgVersion = f (pkgVersion pkg) }
updateVersionBranch f v = v { versionBranch = f (versionBranch v) }
prepareTree :: PackageDescription
-> Verbosity
-> Maybe LocalBuildInfo
-> Bool
-> FilePath
-> [PPSuffixHandler]
-> Int
-> IO FilePath
prepareTree pkg_descr verbosity mb_lbi snapshot tmpDir pps date = do
setupMessage verbosity "Building source dist for" pkg_descr
ex <- doesDirectoryExist tmpDir
when ex (die $ "Source distribution already in place. please move: " ++ tmpDir)
let targetDir = tmpDir </> (nameVersion pkg_descr)
createDirectoryIfMissingVerbose verbosity True targetDir
withLib pkg_descr () $ \ l ->
prepareDir verbosity targetDir pps (exposedModules l) (libBuildInfo l)
withExe pkg_descr $ \ (Executable _ mainPath exeBi) -> do
prepareDir verbosity targetDir pps [] exeBi
srcMainFile <- do
ppFile <- findFileWithExtension (ppSuffixes pps) (hsSourceDirs exeBi) (dropExtension mainPath)
case ppFile of
Nothing -> findFile (hsSourceDirs exeBi) mainPath
Just pp -> return pp
copyFileTo verbosity targetDir srcMainFile
flip mapM_ (dataFiles pkg_descr) $ \ file -> do
let dir = takeDirectory file
createDirectoryIfMissingVerbose verbosity True (targetDir </> dir)
copyFileVerbose verbosity file (targetDir </> file)
when (not (null (licenseFile pkg_descr))) $
copyFileTo verbosity targetDir (licenseFile pkg_descr)
flip mapM_ (extraSrcFiles pkg_descr) $ \ fpath -> do
copyFileTo verbosity targetDir fpath
withLib pkg_descr () $ \ l -> do
let lbi = libBuildInfo l
relincdirs = "." : filter (not.isAbsolute) (includeDirs lbi)
incs <- mapM (findInc relincdirs) (installIncludes lbi)
flip mapM_ incs $ \(_,fpath) ->
copyFileTo verbosity targetDir fpath
when (not (null pps)) $
case mb_lbi of
Just lbi -> preprocessSources pkg_descr (lbi { buildDir = targetDir })
True verbosity pps
Nothing -> warn verbosity
"Cannot run preprocessors. Run 'configure' command first."
hsExists <- doesFileExist "Setup.hs"
lhsExists <- doesFileExist "Setup.lhs"
if hsExists then copyFileTo verbosity targetDir "Setup.hs"
else if lhsExists then copyFileTo verbosity targetDir "Setup.lhs"
else writeFile (targetDir </> "Setup.hs") $ unlines [
"import Distribution.Simple",
"main = defaultMain"]
descFile <- getCurrentDirectory >>= findPackageDesc verbosity
let targetDescFile = targetDir </> descFile
if snapshot then do
contents <- readFile descFile
writeFile targetDescFile $
unlines $ map (appendVersion date) $ lines $ contents
else copyFileVerbose verbosity descFile targetDescFile
return targetDir
where
appendVersion :: Int -> String -> String
appendVersion n line
| "version:" `isPrefixOf` map toLower line =
trimTrailingSpace line ++ "." ++ show n
| otherwise = line
trimTrailingSpace :: String -> String
trimTrailingSpace = reverse . dropWhile isSpace . reverse
findInc [] f = die ("can't find include file " ++ f)
findInc (d:ds) f = do
let path = (d </> f)
b <- doesFileExist path
if b then return (f,path) else findInc ds f
createArchive :: PackageDescription
-> Verbosity
-> Maybe LocalBuildInfo
-> FilePath
-> FilePath
-> IO FilePath
createArchive pkg_descr verbosity mb_lbi tmpDir targetPref = do
let tarBallFilePath = targetPref </> tarBallName pkg_descr
(tarProg, _) <- requireProgram verbosity tarProgram AnyVersion
(maybe defaultProgramConfiguration withPrograms mb_lbi)
rawSystemProgram verbosity tarProg
["-C", tmpDir, "-czf", tarBallFilePath, nameVersion pkg_descr]
`finally` removeDirectoryRecursive tmpDir
notice verbosity $ "Source tarball created: " ++ tarBallFilePath
return tarBallFilePath
prepareDir :: Verbosity
-> FilePath
-> [PPSuffixHandler]
-> [String]
-> BuildInfo
-> IO ()
prepareDir verbosity inPref pps mods BuildInfo{hsSourceDirs=srcDirs, otherModules=mods', cSources=cfiles}
= do let suff = ppSuffixes pps ++ ["hs", "lhs"]
smartCopySources verbosity srcDirs inPref (mods++mods') suff True True
mapM_ (copyFileTo verbosity inPref) cfiles
copyFileTo :: Verbosity -> FilePath -> FilePath -> IO ()
copyFileTo verbosity dir file = do
let targetFile = dir </> file
createDirectoryIfMissingVerbose verbosity True (takeDirectory targetFile)
copyFileVerbose verbosity file targetFile
tarBallName :: PackageDescription -> FilePath
tarBallName p = (nameVersion p) ++ ".tar.gz"
nameVersion :: PackageDescription -> String
nameVersion = showPackageId . package
#ifdef DEBUG
hunitTests :: [Test]
hunitTests = []
#endif