SrcDist.hs 20.3 KB
Newer Older
1 2 3
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

4 5 6 7
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.SrcDist
-- Copyright   :  Simon Marlow 2004
8
-- License     :  BSD3
9
--
Duncan Coutts's avatar
Duncan Coutts committed
10
-- Maintainer  :  cabal-devel@haskell.org
ijones's avatar
ijones committed
11
-- Portability :  portable
12
--
Duncan Coutts's avatar
Duncan Coutts committed
13 14 15 16 17 18 19 20 21
-- 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.
22

23 24 25
-- 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.

26
module Distribution.Simple.SrcDist (
Duncan Coutts's avatar
Duncan Coutts committed
27 28 29 30 31 32 33 34
  -- * The top level action
  sdist,

  -- ** Parts of 'sdist'
  printPackageProblems,
  prepareTree,
  createArchive,

Ian D. Bollinger's avatar
Ian D. Bollinger committed
35
  -- ** Snapshots
Duncan Coutts's avatar
Duncan Coutts committed
36
  prepareSnapshotTree,
37
  snapshotPackage,
Duncan Coutts's avatar
Duncan Coutts committed
38 39
  snapshotVersion,
  dateToSnapshotNumber,
40

refold's avatar
refold committed
41
  -- * Extracting the source files
42 43
  listPackageSources,
  listPackageSourcesWithDie,
refold's avatar
refold committed
44

45 46
  )  where

47 48 49
import Prelude ()
import Distribution.Compat.Prelude

50 51
import Distribution.PackageDescription hiding (Flag)
import Distribution.PackageDescription.Check hiding (doesFileExist)
52
import Distribution.Package
53
import Distribution.ModuleName
54
import qualified Distribution.ModuleName as ModuleName
Duncan Coutts's avatar
Duncan Coutts committed
55
import Distribution.Version
56
import Distribution.Simple.Configure (findDistPrefOrDefault)
57
import Distribution.Simple.Glob
58
import Distribution.Simple.Utils
59 60 61 62
import Distribution.Simple.Setup
import Distribution.Simple.PreProcess
import Distribution.Simple.BuildPaths
import Distribution.Simple.Program
Oleg Grenrus's avatar
Oleg Grenrus committed
63
import Distribution.Pretty
64
import Distribution.Types.ForeignLib
65
import Distribution.Verbosity
66

67
import Data.List (partition)
68
import qualified Data.Map as Map
69
import Data.Time (UTCTime, getCurrentTime, toGregorian, utctDay)
refold's avatar
refold committed
70
import System.Directory ( doesFileExist )
71
import System.IO (IOMode(WriteMode), hPutStrLn, withFile)
72
import System.FilePath ((</>), (<.>), dropExtension, isRelative)
73
import Control.Monad
74

75
-- |Create a source distribution.
76 77 78
sdist :: PackageDescription     -- ^ information from the tarball
      -> SDistFlags             -- ^ verbosity & snapshot
      -> (FilePath -> FilePath) -- ^ build prefix (temp dir)
79
      -> [PPSuffixHandler]      -- ^ extra preprocessors (includes suffixes)
80
      -> IO ()
81
sdist pkg flags mkTmpDir pps = do
82 83 84 85

  distPref <- findDistPrefOrDefault $ sDistDistPref flags
  let targetPref   = distPref
      tmpTargetDir = mkTmpDir distPref
Duncan Coutts's avatar
Duncan Coutts committed
86

87
  -- When given --list-sources, just output the list of sources to a file.
88
  case sDistListSources flags of
89
    Flag path -> withFile path WriteMode $ \outHandle -> do
90
      ordinary <- listPackageSources verbosity "." pkg pps
91
      traverse_ (hPutStrLn outHandle) ordinary
92 93
      notice verbosity $ "List of package sources written to file '" ++ path ++ "'"

94 95 96 97 98 99 100 101 102 103 104
    NoFlag    -> do
      -- do some QA
      printPackageProblems verbosity pkg

      date <- getCurrentTime
      let pkg' | snapshot  = snapshotPackage date pkg
               | otherwise = pkg

      case flagToMaybe (sDistDirectory flags) of
        Just targetDir -> do
          generateSourceDir targetDir pkg'
105
          info verbosity $ "Source directory created: " ++ targetDir
106 107 108

        Nothing -> do
          createDirectoryIfMissingVerbose verbosity True tmpTargetDir
109
          withTempDirectory verbosity tmpTargetDir "sdist." $ \tmpDir -> do
110 111
            let targetDir = tmpDir </> tarBallName pkg'
            generateSourceDir targetDir pkg'
112
            targzFile <- createArchive verbosity pkg' tmpDir targetPref
113
            notice verbosity $ "Source tarball created: " ++ targzFile
Duncan Coutts's avatar
Duncan Coutts committed
114

115
  where
116
    generateSourceDir :: FilePath -> PackageDescription -> IO ()
117 118
    generateSourceDir targetDir pkg' = do
      setupMessage verbosity "Building source dist for" (packageId pkg')
119
      prepareTree verbosity pkg' targetDir pps
120 121 122
      when snapshot $
        overwriteSnapshotPackageDesc verbosity pkg' targetDir

123
    verbosity = fromFlag (sDistVerbosity flags)
Duncan Coutts's avatar
Duncan Coutts committed
124
    snapshot  = fromFlag (sDistSnapshot flags)
125

126 127 128 129 130 131 132 133 134 135 136 137 138 139
-- | List all source files of a package.
--
-- Since @Cabal-3.4@ returns a single list. There shouldn't be any
-- executable files, they are hardly portable.
-- 
listPackageSources
    :: Verbosity          -- ^ verbosity
    -> FilePath           -- ^ directory with cabal file
    -> PackageDescription -- ^ info from the cabal file
    -> [PPSuffixHandler]  -- ^ extra preprocessors (include suffixes)
    -> IO [FilePath]      -- ^ relative paths
listPackageSources verbosity cwd pkg_descr0 pps = do
    -- Call helpers that actually do all work.
    listPackageSources' verbosity die' cwd pkg_descr pps
refold's avatar
refold committed
140
  where
fmaste's avatar
fmaste committed
141
    pkg_descr = filterAutogenModules pkg_descr0
refold's avatar
refold committed
142

143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169
-- | A variant of 'listPackageSources' with configurable 'die'.
--
-- /Note:/ may still 'die' directly. For example on missing include file.
--
-- Since @3.4.0.0
listPackageSourcesWithDie
    :: Verbosity          -- ^ verbosity
    -> (Verbosity -> String -> IO [FilePath]) -- ^ 'die'' alternative
    -> FilePath           -- ^ directory with cabal file
    -> PackageDescription -- ^ info from the cabal file
    -> [PPSuffixHandler]  -- ^ extra preprocessors (include suffixes)
    -> IO [FilePath]      -- ^ relative paths
listPackageSourcesWithDie verbosity rip cwd pkg_descr0 pps = do
    -- Call helpers that actually do all work.
    listPackageSources' verbosity rip cwd pkg_descr pps
  where
    pkg_descr = filterAutogenModules pkg_descr0


listPackageSources'
  :: Verbosity
  -> (Verbosity -> String -> IO [FilePath])
  -> FilePath
  -> PackageDescription
  -> [PPSuffixHandler]
  -> IO [FilePath]
listPackageSources' verbosity rip cwd pkg_descr pps =
170
  fmap concat . sequenceA $
refold's avatar
refold committed
171 172
  [
    -- Library sources.
173
    fmap concat
Edward Z. Yang's avatar
Edward Z. Yang committed
174 175 176 177 178
    . withAllLib $ \Library {
                      exposedModules = modules,
                      signatures     = sigs,
                      libBuildInfo   = libBi
                    } ->
179
     allSourcesBuildInfo verbosity rip cwd libBi pps (modules ++ sigs)
refold's avatar
refold committed
180 181 182

    -- Executables sources.
  , fmap concat
183
    . withAllExe $ \Executable { modulePath = mainPath, buildInfo = exeBi } -> do
184 185
       biSrcs  <- allSourcesBuildInfo verbosity rip cwd exeBi pps []
       mainSrc <- findMainExeFile verbosity cwd exeBi pps mainPath
refold's avatar
refold committed
186 187
       return (mainSrc:biSrcs)

188 189 190
    -- Foreign library sources
  , fmap concat
    . withAllFLib $ \flib@(ForeignLib { foreignLibBuildInfo = flibBi }) -> do
191 192
       biSrcs   <- allSourcesBuildInfo verbosity rip cwd flibBi pps []
       defFiles <- mapM (findModDefFile verbosity cwd flibBi pps)
193
         (foreignLibModDefFile flib)
194 195
       return (defFiles ++ biSrcs)

refold's avatar
refold committed
196 197
    -- Test suites sources.
  , fmap concat
198
    . withAllTest $ \t -> do
refold's avatar
refold committed
199 200 201
       let bi  = testBuildInfo t
       case testInterface t of
         TestSuiteExeV10 _ mainPath -> do
202 203
           biSrcs <- allSourcesBuildInfo verbosity rip cwd bi pps []
           srcMainFile <- findMainExeFile verbosity cwd bi pps mainPath
refold's avatar
refold committed
204 205
           return (srcMainFile:biSrcs)
         TestSuiteLibV09 _ m ->
206
           allSourcesBuildInfo verbosity rip cwd bi pps [m]
207
         TestSuiteUnsupported tp ->
208
           rip verbosity $ "Unsupported test suite type: " ++ show tp
refold's avatar
refold committed
209 210 211

    -- Benchmarks sources.
  , fmap concat
212
    . withAllBenchmark $ \bm -> do
refold's avatar
refold committed
213 214 215
       let  bi = benchmarkBuildInfo bm
       case benchmarkInterface bm of
         BenchmarkExeV10 _ mainPath -> do
216 217
           biSrcs <- allSourcesBuildInfo verbosity rip cwd bi pps []
           srcMainFile <- findMainExeFile verbosity cwd bi pps mainPath
refold's avatar
refold committed
218
           return (srcMainFile:biSrcs)
219 220
         BenchmarkUnsupported tp ->
            rip verbosity $ "Unsupported benchmark type: " ++ show tp
refold's avatar
refold committed
221 222 223

    -- Data files.
  , fmap concat
224
    . for (dataFiles pkg_descr) $ \filename ->
225 226 227 228
        let srcDataDirRaw = dataDir pkg_descr
            srcDataDir = if null srcDataDirRaw
              then "."
              else srcDataDirRaw
229
        in fmap (fmap (\p -> cwd </> srcDataDir </> p)) $
230
             matchDirFileGlob verbosity (specVersion pkg_descr) srcDataDir filename
refold's avatar
refold committed
231

232 233 234 235
    -- Extra source files.
  , fmap concat . for (extraSrcFiles pkg_descr) $ \fpath ->
    matchDirFileGlob verbosity (specVersion pkg_descr) cwd fpath

236 237
    -- Extra doc files.
  , fmap concat
238
    . for (extraDocFiles pkg_descr) $ \ filename ->
239
        matchDirFileGlob verbosity (specVersion pkg_descr) cwd filename
240

Duncan Coutts's avatar
Duncan Coutts committed
241 242
    -- License file(s).
  , return (licenseFiles pkg_descr)
243

Oleg Grenrus's avatar
Oleg Grenrus committed
244
    -- Install-include files, without autogen-include files
245 246
  , fmap concat
    . withAllLib $ \ l -> do
Oleg Grenrus's avatar
Oleg Grenrus committed
247 248
       let lbi   = libBuildInfo l
           incls = filter (`notElem` autogenIncludes lbi) (installIncludes lbi)
249
           relincdirs = "." : filter isRelative (includeDirs lbi)
250
       traverse (fmap snd . findIncludeFile verbosity cwd relincdirs) incls
refold's avatar
refold committed
251

252
    -- Setup script, if it exists.
253
  , fmap (maybe [] (\f -> [f])) $ findSetupFile cwd
refold's avatar
refold committed
254 255

    -- The .cabal file itself.
256
  , fmap (\d -> [d]) (tryFindPackageDescCwd verbosity cwd ".")
refold's avatar
refold committed
257 258 259 260 261

  ]
  where
    -- We have to deal with all libs and executables, so we have local
    -- versions of these functions that ignore the 'buildable' attribute:
262
    withAllLib       action = traverse action (allLibraries pkg_descr)
263
    withAllFLib      action = traverse action (foreignLibs pkg_descr)
264 265 266
    withAllExe       action = traverse action (executables pkg_descr)
    withAllTest      action = traverse action (testSuites pkg_descr)
    withAllBenchmark action = traverse action (benchmarks pkg_descr)
refold's avatar
refold committed
267 268


269
-- |Prepare a directory tree of source files.
Duncan Coutts's avatar
Duncan Coutts committed
270 271
prepareTree :: Verbosity          -- ^verbosity
            -> PackageDescription -- ^info from the cabal file
272
            -> FilePath           -- ^source tree to populate
273
            -> [PPSuffixHandler]  -- ^extra preprocessors (includes suffixes)
274
            -> IO ()
275 276 277 278
prepareTree verbosity pkg_descr0 targetDir pps = do
    ordinary <- listPackageSources verbosity "." pkg_descr pps
    installOrdinaryFiles verbosity targetDir (zip (repeat []) ordinary)
    maybeCreateDefaultSetupScript targetDir
279
  where
fmaste's avatar
fmaste committed
280
    pkg_descr = filterAutogenModules pkg_descr0
refold's avatar
refold committed
281 282

-- | Find the setup script file, if it exists.
283
findSetupFile :: FilePath -> IO (Maybe FilePath)
284
findSetupFile targetDir = do
285 286
  hsExists  <- doesFileExist (targetDir </> setupHs)
  lhsExists <- doesFileExist (targetDir </> setupLhs)
refold's avatar
refold committed
287 288 289 290 291 292
  if hsExists
    then return (Just setupHs)
    else if lhsExists
         then return (Just setupLhs)
         else return Nothing
    where
293 294
      setupHs  = "Setup.hs"
      setupLhs = "Setup.lhs"
295 296

-- | Create a default setup script in the target directory, if it doesn't exist.
297
maybeCreateDefaultSetupScript :: FilePath -> IO ()
298 299 300 301 302 303 304 305
maybeCreateDefaultSetupScript targetDir = do
  mSetupFile <- findSetupFile targetDir
  case mSetupFile of
    Just _setupFile -> return ()
    Nothing         -> do
      writeUTF8File (targetDir </> "Setup.hs") $ unlines [
        "import Distribution.Simple",
        "main = defaultMain"]
refold's avatar
refold committed
306 307

-- | Find the main executable file.
308
findMainExeFile
309 310 311 312 313 314 315 316
  :: Verbosity
  -> FilePath -- ^ cwd
  -> BuildInfo
  -> [PPSuffixHandler]
  -> FilePath -- ^ main-is
  -> IO FilePath
findMainExeFile verbosity cwd exeBi pps mainPath = do
  ppFile <- findFileCwdWithExtension cwd (ppSuffixes pps) (hsSourceDirs exeBi)
refold's avatar
refold committed
317 318
            (dropExtension mainPath)
  case ppFile of
319
    Nothing -> findFileCwd verbosity cwd (hsSourceDirs exeBi) mainPath
refold's avatar
refold committed
320 321
    Just pp -> return pp

322 323 324
-- | Find a module definition file
--
-- TODO: I don't know if this is right
325
findModDefFile
326 327 328
  :: Verbosity -> FilePath -> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath
findModDefFile verbosity cwd flibBi _pps modDefPath =
    findFileCwd verbosity cwd (".":hsSourceDirs flibBi) modDefPath
329

refold's avatar
refold committed
330 331 332
-- | Given a list of include paths, try to find the include file named
-- @f@. Return the name of the file and the full path, or exit with error if
-- there's no such file.
333 334 335
findIncludeFile :: Verbosity -> FilePath -> [FilePath] -> String -> IO (String, FilePath)
findIncludeFile verbosity _ [] f = die' verbosity ("can't find include file " ++ f)
findIncludeFile verbosity cwd (d:ds) f = do
refold's avatar
refold committed
336
  let path = (d </> f)
337 338
  b <- doesFileExist (cwd </> path)
  if b then return (f,path) else findIncludeFile verbosity cwd ds f
refold's avatar
refold committed
339

fmaste's avatar
fmaste committed
340 341 342 343
-- | Remove the auto-generated modules (like 'Paths_*') from 'exposed-modules' 
-- and 'other-modules'.
filterAutogenModules :: PackageDescription -> PackageDescription
filterAutogenModules pkg_descr0 = mapLib filterAutogenModuleLib $
refold's avatar
refold committed
344 345
                                 mapAllBuildInfo filterAutogenModuleBI pkg_descr0
  where
346 347
    mapLib f pkg = pkg { library      = fmap f (library pkg)
                       , subLibraries = map f (subLibraries pkg) }
348
    filterAutogenModuleLib lib = lib {
fmaste's avatar
fmaste committed
349
      exposedModules = filter (filterFunction (libBuildInfo lib)) (exposedModules lib)
350 351
    }
    filterAutogenModuleBI bi = bi {
fmaste's avatar
fmaste committed
352
      otherModules   = filter (filterFunction bi) (otherModules bi)
353
    }
fmaste's avatar
fmaste committed
354 355 356
    pathsModule = autogenPathsModuleName pkg_descr0
    filterFunction bi = \mn ->
                                   mn /= pathsModule
357
                                && not (mn `elem` autogenModules bi)
358

359 360 361
-- | 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'.
Duncan Coutts's avatar
Duncan Coutts committed
362
--
363 364 365 366 367 368 369 370
prepareSnapshotTree
  :: Verbosity          -- ^verbosity
  -> PackageDescription -- ^info from the cabal file
  -> FilePath           -- ^source tree to populate
  -> [PPSuffixHandler]  -- ^extra preprocessors (includes suffixes)
  -> IO ()
prepareSnapshotTree verbosity pkg targetDir pps = do
  prepareTree verbosity pkg targetDir pps
371
  overwriteSnapshotPackageDesc verbosity pkg targetDir
372

373 374 375 376 377 378 379 380 381 382 383
overwriteSnapshotPackageDesc :: Verbosity          -- ^verbosity
                             -> PackageDescription -- ^info from the cabal file
                             -> FilePath           -- ^source tree
                             -> IO ()
overwriteSnapshotPackageDesc verbosity pkg targetDir = do
    -- We could just writePackageDescription targetDescFile pkg_descr,
    -- but that would lose comments and formatting.
    descFile <- defaultPackageDesc verbosity
    withUTF8FileContents descFile $
      writeUTF8File (targetDir </> descFile)
        . unlines . map (replaceVersion (packageVersion pkg)) . lines
Duncan Coutts's avatar
Duncan Coutts committed
384

385
  where
Duncan Coutts's avatar
Duncan Coutts committed
386 387 388
    replaceVersion :: Version -> String -> String
    replaceVersion version line
      | "version:" `isPrefixOf` map toLower line
Oleg Grenrus's avatar
Oleg Grenrus committed
389
                  = "version: " ++ prettyShow version
Duncan Coutts's avatar
Duncan Coutts committed
390 391
      | otherwise = line

392 393 394
-- | Modifies a 'PackageDescription' by appending a snapshot number
-- corresponding to the given date.
--
395
snapshotPackage :: UTCTime -> PackageDescription -> PackageDescription
396 397 398 399 400 401
snapshotPackage date pkg =
  pkg {
    package = pkgid { pkgVersion = snapshotVersion date (pkgVersion pkgid) }
  }
  where pkgid = packageId pkg

Duncan Coutts's avatar
Duncan Coutts committed
402 403 404
-- | Modifies a 'Version' by appending a snapshot number corresponding
-- to the given date.
--
405
snapshotVersion :: UTCTime -> Version -> Version
406
snapshotVersion date = alterVersion (++ [dateToSnapshotNumber date])
Duncan Coutts's avatar
Duncan Coutts committed
407 408 409 410

-- | Given a date produce a corresponding integer representation.
-- For example given a date @18/03/2008@ produce the number @20080318@.
--
411 412 413 414 415 416
dateToSnapshotNumber :: UTCTime -> Int
dateToSnapshotNumber date = case toGregorian (utctDay date) of
                            (year, month, day) ->
                                fromIntegral year * 10000
                              + month             * 100
                              + day
Duncan Coutts's avatar
Duncan Coutts committed
417

418
-- | Create an archive from a tree of source files, and clean up the tree.
419 420 421 422 423 424 425
createArchive
    :: Verbosity            -- ^ verbosity
    -> PackageDescription   -- ^ info from cabal file
    -> FilePath             -- ^ source tree to archive
    -> FilePath             -- ^ name of archive to create
    -> IO FilePath
createArchive verbosity pkg_descr tmpDir targetPref = do
Duncan Coutts's avatar
Duncan Coutts committed
426
  let tarBallFilePath = targetPref </> tarBallName pkg_descr <.> "tar.gz"
427
  (tarProg, _) <- requireProgram verbosity tarProgram defaultProgramDb
428 429 430
  let formatOptSupported = maybe False (== "YES") $
                           Map.lookup "Supports --format"
                           (programProperties tarProg)
431
  runProgram verbosity tarProg $
432 433 434 435
    -- Hmm: I could well be skating on thinner ice here by using the -C option
    -- (=> seems to be supported at least by GNU and *BSD tar) [The
    -- prev. solution used pipes and sub-command sequences to set up the paths
    -- correctly, which is problematic in a Windows setting.]
436 437 438
    ["-czf", tarBallFilePath, "-C", tmpDir]
    ++ (if formatOptSupported then ["--format", "ustar"] else [])
    ++ [tarBallName pkg_descr]
439
  return tarBallFilePath
ijones's avatar
ijones committed
440

refold's avatar
refold committed
441
-- | Given a buildinfo, return the names of all source files.
442 443 444 445 446 447 448 449 450
allSourcesBuildInfo
    :: Verbosity
    -> (Verbosity -> String -> IO [FilePath])
    -> FilePath          -- ^ cwd
    -> BuildInfo
    -> [PPSuffixHandler] -- ^ Extra preprocessors
    -> [ModuleName]      -- ^ Exposed modules
    -> IO [FilePath]
allSourcesBuildInfo verbosity rip cwd bi pps modules = do
refold's avatar
refold committed
451
  let searchDirs = hsSourceDirs bi
452
  sources <- fmap concat $ sequenceA $
refold's avatar
refold committed
453
    [ let file = ModuleName.toFilePath module_
454 455 456
      -- NB: *Not* findFileWithExtension, because the same source
      -- file may show up in multiple paths due to a conditional;
      -- we need to package all of them.  See #367.
457
      in findAllFilesCwdWithExtension cwd suffixes searchDirs file
458
         >>= nonEmpty (notFound module_) return
refold's avatar
refold committed
459
    | module_ <- modules ++ otherModules bi ]
460
  bootFiles <- sequenceA
refold's avatar
refold committed
461 462
    [ let file = ModuleName.toFilePath module_
          fileExts = ["hs-boot", "lhs-boot"]
463
      in findFileCwdWithExtension cwd fileExts (hsSourceDirs bi) file
refold's avatar
refold committed
464 465
    | module_ <- modules ++ otherModules bi ]

466 467
  return $ sources ++ catMaybes bootFiles ++ cSources bi ++ cxxSources bi ++
           cmmSources bi ++ asmSources bi ++ jsSources bi
refold's avatar
refold committed
468 469

  where
470 471
    nonEmpty x _ [] = x
    nonEmpty _ f xs = f xs
Edward Z. Yang's avatar
Edward Z. Yang committed
472
    suffixes = ppSuffixes pps ++ ["hs", "lhs", "hsig", "lhsig"]
473 474 475

    notFound :: ModuleName -> IO [FilePath]
    notFound m = rip verbosity $ "Error: Could not find module: " ++ prettyShow m
fmaste's avatar
fmaste committed
476 477
                 ++ " with any suffix: " ++ show suffixes ++ ". If the module "
                 ++ "is autogenerated it should be added to 'autogen-modules'."
refold's avatar
refold committed
478

479

480 481
-- | Note: must be called with the CWD set to the directory containing
-- the '.cabal' file.
482 483
printPackageProblems :: Verbosity -> PackageDescription -> IO ()
printPackageProblems verbosity pkg_descr = do
484
  ioChecks      <- checkPackageFiles verbosity pkg_descr "."
485
  let pureChecks = checkConfiguredPackage pkg_descr
486 487 488
      isDistError (PackageDistSuspicious     _) = False
      isDistError (PackageDistSuspiciousWarn _) = False
      isDistError _                             = True
489 490 491 492 493 494
      (errors, warnings) = partition isDistError (pureChecks ++ ioChecks)
  unless (null errors) $
      notice verbosity $ "Distribution quality errors:\n"
                      ++ unlines (map explanation errors)
  unless (null warnings) $
      notice verbosity $ "Distribution quality warnings:\n"
495
                      ++ unlines (map explanation warnings)
496 497
  unless (null errors) $
      notice verbosity
498
        "Note: the public hackage server would reject this package."
499

ijones's avatar
ijones committed
500 501
------------------------------------------------------------

Duncan Coutts's avatar
Duncan Coutts committed
502 503 504
-- | The name of the tarball without extension
--
tarBallName :: PackageDescription -> String
Oleg Grenrus's avatar
Oleg Grenrus committed
505
tarBallName = prettyShow . packageId
506 507 508 509

mapAllBuildInfo :: (BuildInfo -> BuildInfo)
                -> (PackageDescription -> PackageDescription)
mapAllBuildInfo f pkg = pkg {
510 511
    library     = fmap mapLibBi (library pkg),
    subLibraries = fmap mapLibBi (subLibraries pkg),
512
    foreignLibs = fmap mapFLibBi (foreignLibs pkg),
513
    executables = fmap mapExeBi (executables pkg),
514 515
    testSuites  = fmap mapTestBi (testSuites pkg),
    benchmarks  = fmap mapBenchBi (benchmarks pkg)
516 517
  }
  where
518 519 520 521 522
    mapLibBi   lib  = lib  { libBuildInfo        = f (libBuildInfo lib) }
    mapFLibBi  flib = flib { foreignLibBuildInfo = f (foreignLibBuildInfo flib) }
    mapExeBi   exe  = exe  { buildInfo           = f (buildInfo exe) }
    mapTestBi  tst  = tst  { testBuildInfo       = f (testBuildInfo tst) }
    mapBenchBi bm   = bm   { benchmarkBuildInfo  = f (benchmarkBuildInfo bm) }