forked from haskell/cabal
-
Notifications
You must be signed in to change notification settings - Fork 0
/
SrcDist.hs
128 lines (112 loc) · 5.48 KB
/
SrcDist.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
-- Implements the \"@.\/cabal sdist@\" command, which creates a source
-- distribution for this package. That is, packs up the source code
-- into a tarball, making use of the corresponding Cabal module.
module Distribution.Client.SrcDist (
sdist
) where
import Distribution.Client.SetupWrapper
( SetupScriptOptions(..), defaultSetupScriptOptions, setupWrapper )
import Distribution.Client.Tar (createTarGzFile)
import Distribution.Package
( Package(..) )
import Distribution.PackageDescription
( PackageDescription )
import Distribution.PackageDescription.Configuration
( flattenPackageDescription )
import Distribution.PackageDescription.Parse
( readPackageDescription )
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, defaultPackageDesc
, die, notice, withTempDirectory )
import Distribution.Client.Setup
( SDistFlags(..), SDistExFlags(..), ArchiveFormat(..) )
import Distribution.Simple.Setup
( Flag(..), sdistCommand, flagToList, fromFlag, fromFlagOrDefault )
import Distribution.Simple.BuildPaths ( srcPref)
import Distribution.Simple.Program (requireProgram, simpleProgram, programPath)
import Distribution.Simple.Program.Db (emptyProgramDb)
import Distribution.Text ( display )
import Distribution.Verbosity (Verbosity)
import Distribution.Version (Version(..), orLaterVersion)
import System.FilePath ((</>), (<.>))
import Control.Monad (when, unless)
import System.Directory (doesFileExist, removeFile, canonicalizePath)
import System.Process (runProcess, waitForProcess)
import System.Exit (ExitCode(..))
-- |Create a source distribution.
sdist :: SDistFlags -> SDistExFlags -> IO ()
sdist flags exflags = do
pkg <- return . flattenPackageDescription
=<< readPackageDescription verbosity
=<< defaultPackageDesc verbosity
let withDir = if isOutDirectory then (\f -> f tmpTargetDir)
else withTempDirectory verbosity False tmpTargetDir "sdist."
-- Otherwise 'withTempDir' fails...
createDirectoryIfMissingVerbose verbosity True tmpTargetDir
withDir $ \tmpDir -> do
let outDir = if isOutDirectory then tmpDir else tmpDir </> tarBallName pkg
flags' = if isOutDirectory then flags
else flags { sDistDirectory = Flag outDir }
createDirectoryIfMissingVerbose verbosity True outDir
-- Run 'setup sdist --output-directory=tmpDir'
setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags') []
-- And unless we were given --list-sources or --output-directory ourselves,
-- create an archive.
unless (isListSources || isOutDirectory) $
createArchive verbosity pkg tmpDir distPref
where
flagEnabled f = not . null . flagToList . f $ flags
isListSources = flagEnabled sDistListSources
isOutDirectory = flagEnabled sDistDirectory
verbosity = fromFlag (sDistVerbosity flags)
distPref = fromFlag (sDistDistPref flags)
tmpTargetDir = fromFlagOrDefault (srcPref distPref) (sDistDirectory flags)
setupOpts = defaultSetupScriptOptions {
-- The '--output-directory' sdist flag was introduced in Cabal 1.12, and
-- '--list-sources' in 1.17.
useCabalVersion = if isListSources
then orLaterVersion $ Version [1,17,0] []
else orLaterVersion $ Version [1,12,0] []
}
format = fromFlag (sDistFormat exflags)
createArchive = case format of
TargzFormat -> createTarGzArchive
ZipFormat -> createZipArchive
tarBallName :: PackageDescription -> String
tarBallName = display . packageId
-- | Create a tar.gz archive from a tree of source files.
createTarGzArchive :: Verbosity -> PackageDescription -> FilePath -> FilePath
-> IO ()
createTarGzArchive verbosity pkg tmpDir targetPref = do
createTarGzFile tarBallFilePath tmpDir (tarBallName pkg)
notice verbosity $ "Source tarball created: " ++ tarBallFilePath
where
tarBallFilePath = targetPref </> tarBallName pkg <.> "tar.gz"
-- | Create a zip archive from a tree of source files.
createZipArchive :: Verbosity -> PackageDescription -> FilePath -> FilePath
-> IO ()
createZipArchive verbosity pkg tmpDir targetPref = do
let dir = tarBallName pkg
zipfile = targetPref </> dir <.> "zip"
(zipProg, _) <- requireProgram verbosity zipProgram emptyProgramDb
-- zip has an annoying habbit of updating the target rather than creating
-- it from scratch. While that might sound like an optimisation, it doesn't
-- remove files already in the archive that are no longer present in the
-- uncompressed tree.
alreadyExists <- doesFileExist zipfile
when alreadyExists $ removeFile zipfile
-- We call zip with a different CWD, so have to make the path
-- absolute. Can't just use 'canonicalizePath zipfile' since this function
-- requires its argument to refer to an existing file.
zipfileAbs <- fmap (</> dir <.> "zip") . canonicalizePath $ targetPref
--TODO: use runProgramInvocation, but has to be able to set CWD
hnd <- runProcess (programPath zipProg) ["-q", "-r", zipfileAbs, dir]
(Just tmpDir)
Nothing Nothing Nothing Nothing
exitCode <- waitForProcess hnd
unless (exitCode == ExitSuccess) $
die $ "Generating the zip file failed "
++ "(zip returned exit code " ++ show exitCode ++ ")"
notice verbosity $ "Source zip archive created: " ++ zipfileAbs
where
zipProgram = simpleProgram "zip"