{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------

-- 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.

-- |
-- Module      :  Distribution.Simple.SrcDist
-- Copyright   :  Simon Marlow 2004
-- License     :  BSD3
--
-- 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.
module Distribution.Simple.SrcDist
  ( -- * The top level action
    sdist

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

    -- ** Snapshots
  , prepareSnapshotTree
  , snapshotPackage
  , snapshotVersion
  , dateToSnapshotNumber

    -- * Extracting the source files
  , listPackageSources
  , listPackageSourcesWithDie
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.ModuleName
import qualified Distribution.ModuleName as ModuleName
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Check hiding (doesFileExist)
import Distribution.Pretty
import Distribution.Simple.BuildPaths
import Distribution.Simple.Configure (findDistPrefOrDefault)
import Distribution.Simple.Flag
import Distribution.Simple.Glob (matchDirFileGlobWithDie)
import Distribution.Simple.PreProcess
import Distribution.Simple.Program
import Distribution.Simple.Setup.SDist
import Distribution.Simple.Utils
import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version

import qualified Data.Map as Map
import Data.Time (UTCTime, getCurrentTime, toGregorian, utctDay)
import Distribution.Simple.Errors
import System.Directory (doesFileExist)
import System.FilePath (dropExtension, isRelative, (<.>), (</>))
import System.IO (IOMode (WriteMode), hPutStrLn, withFile)

-- | Create a source distribution.
sdist
  :: PackageDescription
  -- ^ information from the tarball
  -> SDistFlags
  -- ^ verbosity & snapshot
  -> (FilePath -> FilePath)
  -- ^ build prefix (temp dir)
  -> [PPSuffixHandler]
  -- ^ extra preprocessors (includes suffixes)
  -> IO ()
sdist :: PackageDescription
-> SDistFlags
-> (FilePath -> FilePath)
-> [PPSuffixHandler]
-> IO ()
sdist PackageDescription
pkg SDistFlags
flags FilePath -> FilePath
mkTmpDir [PPSuffixHandler]
pps = do
  distPref <- Flag FilePath -> IO FilePath
findDistPrefOrDefault (Flag FilePath -> IO FilePath) -> Flag FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ SDistFlags -> Flag FilePath
sDistDistPref SDistFlags
flags
  let targetPref = FilePath
distPref
      tmpTargetDir = FilePath -> FilePath
mkTmpDir FilePath
distPref

  -- When given --list-sources, just output the list of sources to a file.
  case sDistListSources flags of
    Flag FilePath
path -> FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
path IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
outHandle -> do
      ordinary <- Verbosity
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources Verbosity
verbosity FilePath
"." PackageDescription
pkg [PPSuffixHandler]
pps
      traverse_ (hPutStrLn outHandle) ordinary
      notice verbosity $ "List of package sources written to file '" ++ path ++ "'"
    Flag FilePath
NoFlag -> do
      -- do some QA
      Verbosity -> PackageDescription -> IO ()
printPackageProblems Verbosity
verbosity PackageDescription
pkg

      date <- IO UTCTime
getCurrentTime
      let pkg'
            | Bool
snapshot = UTCTime -> PackageDescription -> PackageDescription
snapshotPackage UTCTime
date PackageDescription
pkg
            | Bool
otherwise = PackageDescription
pkg

      case flagToMaybe (sDistDirectory flags) of
        Just FilePath
targetDir -> do
          FilePath -> PackageDescription -> IO ()
generateSourceDir FilePath
targetDir PackageDescription
pkg'
          Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Source directory created: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
targetDir
        Maybe FilePath
Nothing -> do
          Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True FilePath
tmpTargetDir
          Verbosity -> FilePath -> FilePath -> (FilePath -> IO ()) -> IO ()
forall a.
Verbosity -> FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempDirectory Verbosity
verbosity FilePath
tmpTargetDir FilePath
"sdist." ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
tmpDir -> do
            let targetDir :: FilePath
targetDir = FilePath
tmpDir FilePath -> FilePath -> FilePath
</> PackageDescription -> FilePath
tarBallName PackageDescription
pkg'
            FilePath -> PackageDescription -> IO ()
generateSourceDir FilePath
targetDir PackageDescription
pkg'
            targzFile <- Verbosity
-> PackageDescription -> FilePath -> FilePath -> IO FilePath
createArchive Verbosity
verbosity PackageDescription
pkg' FilePath
tmpDir FilePath
targetPref
            notice verbosity $ "Source tarball created: " ++ targzFile
  where
    generateSourceDir :: FilePath -> PackageDescription -> IO ()
    generateSourceDir :: FilePath -> PackageDescription -> IO ()
generateSourceDir FilePath
targetDir PackageDescription
pkg' = do
      Verbosity -> FilePath -> PackageIdentifier -> IO ()
setupMessage Verbosity
verbosity FilePath
"Building source dist for" (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg')
      Verbosity
-> PackageDescription -> FilePath -> [PPSuffixHandler] -> IO ()
prepareTree Verbosity
verbosity PackageDescription
pkg' FilePath
targetDir [PPSuffixHandler]
pps
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
snapshot (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Verbosity -> PackageDescription -> FilePath -> IO ()
overwriteSnapshotPackageDesc Verbosity
verbosity PackageDescription
pkg' FilePath
targetDir

    verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (SDistFlags -> Flag Verbosity
sDistVerbosity SDistFlags
flags)
    snapshot :: Bool
snapshot = Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (SDistFlags -> Flag Bool
sDistSnapshot SDistFlags
flags)

-- | 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
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources Verbosity
verbosity FilePath
cwd PackageDescription
pkg_descr0 [PPSuffixHandler]
pps = do
  -- Call helpers that actually do all work.
  Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources' Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException FilePath
cwd PackageDescription
pkg_descr [PPSuffixHandler]
pps
  where
    pkg_descr :: PackageDescription
pkg_descr = PackageDescription -> PackageDescription
filterAutogenModules PackageDescription
pkg_descr0

-- | 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 -> CabalException -> IO [FilePath])
  -- ^ 'die'' alternative.
  -- Since 'die'' prefixes the error message with 'errorPrefix',
  -- whatever is passed in here and wants to die should do the same.
  -- See issue #7331.
  -> FilePath
  -- ^ directory with cabal file
  -> PackageDescription
  -- ^ info from the cabal file
  -> [PPSuffixHandler]
  -- ^ extra preprocessors (include suffixes)
  -> IO [FilePath]
  -- ^ relative paths
listPackageSourcesWithDie :: Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSourcesWithDie Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd PackageDescription
pkg_descr0 [PPSuffixHandler]
pps = do
  -- Call helpers that actually do all work.
  Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources' Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd PackageDescription
pkg_descr [PPSuffixHandler]
pps
  where
    pkg_descr :: PackageDescription
pkg_descr = PackageDescription -> PackageDescription
filterAutogenModules PackageDescription
pkg_descr0

listPackageSources'
  :: Verbosity
  -- ^ verbosity
  -> (Verbosity -> CabalException -> IO [FilePath])
  -- ^ 'die'' alternative.
  -- Since 'die'' prefixes the error message with 'errorPrefix',
  -- whatever is passed in here and wants to die should do the same.
  -- See issue #7331.
  -> FilePath
  -- ^ directory with cabal file
  -> PackageDescription
  -- ^ info from the cabal file
  -> [PPSuffixHandler]
  -- ^ extra preprocessors (include suffixes)
  -> IO [FilePath]
  -- ^ relative paths
listPackageSources' :: Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources' Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd PackageDescription
pkg_descr [PPSuffixHandler]
pps =
  ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[FilePath]] -> IO [FilePath])
-> ([IO [FilePath]] -> IO [[FilePath]])
-> [IO [FilePath]]
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IO [FilePath]] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([IO [FilePath]] -> IO [FilePath])
-> [IO [FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
    [ -- Library sources.
      ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[FilePath]] -> IO [FilePath])
-> ((Library -> IO [FilePath]) -> IO [[FilePath]])
-> (Library -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> IO [FilePath]) -> IO [[FilePath]]
forall {f :: * -> *} {b}.
Applicative f =>
(Library -> f b) -> f [b]
withAllLib
        ((Library -> IO [FilePath]) -> IO [FilePath])
-> (Library -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \Library
            { exposedModules :: Library -> [ModuleName]
exposedModules = [ModuleName]
modules
            , signatures :: Library -> [ModuleName]
signatures = [ModuleName]
sigs
            , libBuildInfo :: Library -> BuildInfo
libBuildInfo = BuildInfo
libBi
            } ->
            Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd BuildInfo
libBi [PPSuffixHandler]
pps ([ModuleName]
modules [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ [ModuleName]
sigs)
    , -- Executables sources.
      ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[FilePath]] -> IO [FilePath])
-> ((Executable -> IO [FilePath]) -> IO [[FilePath]])
-> (Executable -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Executable -> IO [FilePath]) -> IO [[FilePath]]
forall {f :: * -> *} {b}.
Applicative f =>
(Executable -> f b) -> f [b]
withAllExe
        ((Executable -> IO [FilePath]) -> IO [FilePath])
-> (Executable -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \Executable{modulePath :: Executable -> FilePath
modulePath = FilePath
mainPath, buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
exeBi} -> do
          biSrcs <- Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd BuildInfo
exeBi [PPSuffixHandler]
pps []
          mainSrc <- findMainExeFile verbosity cwd exeBi pps mainPath
          return (mainSrc : biSrcs)
    , -- Foreign library sources
      ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[FilePath]] -> IO [FilePath])
-> ((ForeignLib -> IO [FilePath]) -> IO [[FilePath]])
-> (ForeignLib -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ForeignLib -> IO [FilePath]) -> IO [[FilePath]]
forall {f :: * -> *} {b}.
Applicative f =>
(ForeignLib -> f b) -> f [b]
withAllFLib
        ((ForeignLib -> IO [FilePath]) -> IO [FilePath])
-> (ForeignLib -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \flib :: ForeignLib
flib@(ForeignLib{foreignLibBuildInfo :: ForeignLib -> BuildInfo
foreignLibBuildInfo = BuildInfo
flibBi}) -> do
          biSrcs <- Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd BuildInfo
flibBi [PPSuffixHandler]
pps []
          defFiles <-
            traverse
              (findModDefFile verbosity cwd flibBi pps)
              (foreignLibModDefFile flib)
          return (defFiles ++ biSrcs)
    , -- Test suites sources.
      ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[FilePath]] -> IO [FilePath])
-> ((TestSuite -> IO [FilePath]) -> IO [[FilePath]])
-> (TestSuite -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestSuite -> IO [FilePath]) -> IO [[FilePath]]
forall {f :: * -> *} {b}.
Applicative f =>
(TestSuite -> f b) -> f [b]
withAllTest
        ((TestSuite -> IO [FilePath]) -> IO [FilePath])
-> (TestSuite -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \TestSuite
t -> do
          let bi :: BuildInfo
bi = TestSuite -> BuildInfo
testBuildInfo TestSuite
t
          case TestSuite -> TestSuiteInterface
testInterface TestSuite
t of
            TestSuiteExeV10 Version
_ FilePath
mainPath -> do
              biSrcs <- Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd BuildInfo
bi [PPSuffixHandler]
pps []
              srcMainFile <- findMainExeFile verbosity cwd bi pps mainPath
              return (srcMainFile : biSrcs)
            TestSuiteLibV09 Version
_ ModuleName
m ->
              Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd BuildInfo
bi [PPSuffixHandler]
pps [ModuleName
m]
            TestSuiteUnsupported TestType
tp ->
              Verbosity -> CabalException -> IO [FilePath]
rip Verbosity
verbosity (CabalException -> IO [FilePath])
-> CabalException -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalException
UnsupportedTestSuite (TestType -> FilePath
forall a. Show a => a -> FilePath
show TestType
tp)
    , -- Benchmarks sources.
      ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[FilePath]] -> IO [FilePath])
-> ((Benchmark -> IO [FilePath]) -> IO [[FilePath]])
-> (Benchmark -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Benchmark -> IO [FilePath]) -> IO [[FilePath]]
forall {f :: * -> *} {b}.
Applicative f =>
(Benchmark -> f b) -> f [b]
withAllBenchmark
        ((Benchmark -> IO [FilePath]) -> IO [FilePath])
-> (Benchmark -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \Benchmark
bm -> do
          let bi :: BuildInfo
bi = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bm
          case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
            BenchmarkExeV10 Version
_ FilePath
mainPath -> do
              biSrcs <- Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd BuildInfo
bi [PPSuffixHandler]
pps []
              srcMainFile <- findMainExeFile verbosity cwd bi pps mainPath
              return (srcMainFile : biSrcs)
            BenchmarkUnsupported BenchmarkType
tp ->
              Verbosity -> CabalException -> IO [FilePath]
rip Verbosity
verbosity (CabalException -> IO [FilePath])
-> CabalException -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalException
UnsupportedBenchMark (BenchmarkType -> FilePath
forall a. Show a => a -> FilePath
show BenchmarkType
tp)
    , -- Data files.
      ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[FilePath]] -> IO [FilePath])
-> ((FilePath -> IO [FilePath]) -> IO [[FilePath]])
-> (FilePath -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PackageDescription -> [FilePath]
dataFiles PackageDescription
pkg_descr)
        ((FilePath -> IO [FilePath]) -> IO [FilePath])
-> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
filename ->
          do
            let srcDataDirRaw :: FilePath
srcDataDirRaw = PackageDescription -> FilePath
dataDir PackageDescription
pkg_descr
                srcDataDir :: FilePath
srcDataDir
                  | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
srcDataDirRaw = FilePath
"."
                  | Bool
otherwise = FilePath
srcDataDirRaw
            Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> CabalSpecVersion
-> FilePath
-> FilePath
-> IO [FilePath]
matchDirFileGlobWithDie Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) FilePath
cwd (FilePath
srcDataDir FilePath -> FilePath -> FilePath
</> FilePath
filename)
    , -- Extra source files.
      ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[FilePath]] -> IO [FilePath])
-> ((FilePath -> IO [FilePath]) -> IO [[FilePath]])
-> (FilePath -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PackageDescription -> [FilePath]
extraSrcFiles PackageDescription
pkg_descr) ((FilePath -> IO [FilePath]) -> IO [FilePath])
-> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
fpath ->
        Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> CabalSpecVersion
-> FilePath
-> FilePath
-> IO [FilePath]
matchDirFileGlobWithDie Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) FilePath
cwd FilePath
fpath
    , -- Extra doc files.
      ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[FilePath]] -> IO [FilePath])
-> ((FilePath -> IO [FilePath]) -> IO [[FilePath]])
-> (FilePath -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PackageDescription -> [FilePath]
extraDocFiles PackageDescription
pkg_descr)
        ((FilePath -> IO [FilePath]) -> IO [FilePath])
-> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
filename ->
          Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> CabalSpecVersion
-> FilePath
-> FilePath
-> IO [FilePath]
matchDirFileGlobWithDie Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) FilePath
cwd FilePath
filename
    , -- License file(s).
      [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SymbolicPath PackageDir LicenseFile -> FilePath)
-> [SymbolicPath PackageDir LicenseFile] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir LicenseFile -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath ([SymbolicPath PackageDir LicenseFile] -> [FilePath])
-> [SymbolicPath PackageDir LicenseFile] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles PackageDescription
pkg_descr)
    , -- Install-include files, without autogen-include files
      ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[FilePath]] -> IO [FilePath])
-> ((Library -> IO [FilePath]) -> IO [[FilePath]])
-> (Library -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> IO [FilePath]) -> IO [[FilePath]]
forall {f :: * -> *} {b}.
Applicative f =>
(Library -> f b) -> f [b]
withAllLib
        ((Library -> IO [FilePath]) -> IO [FilePath])
-> (Library -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \Library
l -> do
          let lbi :: BuildInfo
lbi = Library -> BuildInfo
libBuildInfo Library
l
              incls :: [FilePath]
incls = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` BuildInfo -> [FilePath]
autogenIncludes BuildInfo
lbi) (BuildInfo -> [FilePath]
installIncludes BuildInfo
lbi)
              relincdirs :: [FilePath]
relincdirs = FilePath
"." FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isRelative (BuildInfo -> [FilePath]
includeDirs BuildInfo
lbi)
          (FilePath -> IO FilePath) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((FilePath, FilePath) -> FilePath)
-> IO (FilePath, FilePath) -> IO FilePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd (IO (FilePath, FilePath) -> IO FilePath)
-> (FilePath -> IO (FilePath, FilePath)) -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity
-> FilePath -> [FilePath] -> FilePath -> IO (FilePath, FilePath)
findIncludeFile Verbosity
verbosity FilePath
cwd [FilePath]
relincdirs) [FilePath]
incls
    , -- Setup script, if it exists.
      (Maybe FilePath -> [FilePath])
-> IO (Maybe FilePath) -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath]
-> (FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FilePath
f -> [FilePath
f])) (IO (Maybe FilePath) -> IO [FilePath])
-> IO (Maybe FilePath) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe FilePath)
findSetupFile FilePath
cwd
    , -- The .cabal file itself.
      (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FilePath
d -> [FilePath
d]) (Verbosity -> FilePath -> FilePath -> IO FilePath
tryFindPackageDescCwd Verbosity
verbosity FilePath
cwd FilePath
".")
    ]
  where
    -- We have to deal with all libs and executables, so we have local
    -- versions of these functions that ignore the 'buildable' attribute:
    withAllLib :: (Library -> f b) -> f [b]
withAllLib Library -> f b
action = (Library -> f b) -> [Library] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Library -> f b
action (PackageDescription -> [Library]
allLibraries PackageDescription
pkg_descr)
    withAllFLib :: (ForeignLib -> f b) -> f [b]
withAllFLib ForeignLib -> f b
action = (ForeignLib -> f b) -> [ForeignLib] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ForeignLib -> f b
action (PackageDescription -> [ForeignLib]
foreignLibs PackageDescription
pkg_descr)
    withAllExe :: (Executable -> f b) -> f [b]
withAllExe Executable -> f b
action = (Executable -> f b) -> [Executable] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Executable -> f b
action (PackageDescription -> [Executable]
executables PackageDescription
pkg_descr)
    withAllTest :: (TestSuite -> f b) -> f [b]
withAllTest TestSuite -> f b
action = (TestSuite -> f b) -> [TestSuite] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse TestSuite -> f b
action (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg_descr)
    withAllBenchmark :: (Benchmark -> f b) -> f [b]
withAllBenchmark Benchmark -> f b
action = (Benchmark -> f b) -> [Benchmark] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Benchmark -> f b
action (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg_descr)

-- | Prepare a directory tree of source files.
prepareTree
  :: Verbosity
  -- ^ verbosity
  -> PackageDescription
  -- ^ info from the cabal file
  -> FilePath
  -- ^ source tree to populate
  -> [PPSuffixHandler]
  -- ^ extra preprocessors (includes suffixes)
  -> IO ()
prepareTree :: Verbosity
-> PackageDescription -> FilePath -> [PPSuffixHandler] -> IO ()
prepareTree Verbosity
verbosity PackageDescription
pkg_descr0 FilePath
targetDir [PPSuffixHandler]
pps = do
  ordinary <- Verbosity
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources Verbosity
verbosity FilePath
"." PackageDescription
pkg_descr [PPSuffixHandler]
pps
  installOrdinaryFiles verbosity targetDir (zip (repeat []) ordinary)
  maybeCreateDefaultSetupScript targetDir
  where
    pkg_descr :: PackageDescription
pkg_descr = PackageDescription -> PackageDescription
filterAutogenModules PackageDescription
pkg_descr0

-- | Find the setup script file, if it exists.
findSetupFile :: FilePath -> IO (Maybe FilePath)
findSetupFile :: FilePath -> IO (Maybe FilePath)
findSetupFile FilePath
targetDir = do
  hsExists <- FilePath -> IO Bool
doesFileExist (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
setupHs)
  lhsExists <- doesFileExist (targetDir </> setupLhs)
  if hsExists
    then return (Just setupHs)
    else
      if lhsExists
        then return (Just setupLhs)
        else return Nothing
  where
    setupHs :: FilePath
setupHs = FilePath
"Setup.hs"
    setupLhs :: FilePath
setupLhs = FilePath
"Setup.lhs"

-- | Create a default setup script in the target directory, if it doesn't exist.
maybeCreateDefaultSetupScript :: FilePath -> IO ()
maybeCreateDefaultSetupScript :: FilePath -> IO ()
maybeCreateDefaultSetupScript FilePath
targetDir = do
  mSetupFile <- FilePath -> IO (Maybe FilePath)
findSetupFile FilePath
targetDir
  case mSetupFile of
    Just FilePath
_setupFile -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Maybe FilePath
Nothing -> do
      FilePath -> FilePath -> IO ()
writeUTF8File (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
"Setup.hs") (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
        [FilePath] -> FilePath
unlines
          [ FilePath
"import Distribution.Simple"
          , FilePath
"main = defaultMain"
          ]

-- | Find the main executable file.
findMainExeFile
  :: Verbosity
  -> FilePath
  -- ^ cwd
  -> BuildInfo
  -> [PPSuffixHandler]
  -> FilePath
  -- ^ main-is
  -> IO FilePath
findMainExeFile :: Verbosity
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> FilePath
-> IO FilePath
findMainExeFile Verbosity
verbosity FilePath
cwd BuildInfo
exeBi [PPSuffixHandler]
pps FilePath
mainPath = do
  ppFile <-
    FilePath
-> [Suffix] -> [FilePath] -> FilePath -> IO (Maybe FilePath)
findFileCwdWithExtension
      FilePath
cwd
      ([PPSuffixHandler] -> [Suffix]
ppSuffixes [PPSuffixHandler]
pps)
      ((SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
exeBi))
      (FilePath -> FilePath
dropExtension FilePath
mainPath)
  case ppFile of
    Maybe FilePath
Nothing -> Verbosity -> FilePath -> [FilePath] -> FilePath -> IO FilePath
findFileCwd Verbosity
verbosity FilePath
cwd ((SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
exeBi)) FilePath
mainPath
    Just FilePath
pp -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
pp

-- | Find a module definition file
--
-- TODO: I don't know if this is right
findModDefFile
  :: Verbosity -> FilePath -> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath
findModDefFile :: Verbosity
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> FilePath
-> IO FilePath
findModDefFile Verbosity
verbosity FilePath
cwd BuildInfo
flibBi [PPSuffixHandler]
_pps FilePath
modDefPath =
  Verbosity -> FilePath -> [FilePath] -> FilePath -> IO FilePath
findFileCwd Verbosity
verbosity FilePath
cwd (FilePath
"." FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
flibBi)) FilePath
modDefPath

-- | 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.
findIncludeFile :: Verbosity -> FilePath -> [FilePath] -> String -> IO (String, FilePath)
findIncludeFile :: Verbosity
-> FilePath -> [FilePath] -> FilePath -> IO (FilePath, FilePath)
findIncludeFile Verbosity
verbosity FilePath
_ [] FilePath
f = Verbosity -> CabalException -> IO (FilePath, FilePath)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO (FilePath, FilePath))
-> CabalException -> IO (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalException
NoIncludeFileFound FilePath
f
findIncludeFile Verbosity
verbosity FilePath
cwd (FilePath
d : [FilePath]
ds) FilePath
f = do
  let path :: FilePath
path = (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
f)
  b <- FilePath -> IO Bool
doesFileExist (FilePath
cwd FilePath -> FilePath -> FilePath
</> FilePath
path)
  if b then return (f, path) else findIncludeFile verbosity cwd ds f

-- | Remove the auto-generated modules (like 'Paths_*') from 'exposed-modules'
-- and 'other-modules'.
filterAutogenModules :: PackageDescription -> PackageDescription
filterAutogenModules :: PackageDescription -> PackageDescription
filterAutogenModules PackageDescription
pkg_descr0 =
  (Library -> Library) -> PackageDescription -> PackageDescription
mapLib Library -> Library
filterAutogenModuleLib (PackageDescription -> PackageDescription)
-> PackageDescription -> PackageDescription
forall a b. (a -> b) -> a -> b
$
    (BuildInfo -> BuildInfo)
-> PackageDescription -> PackageDescription
mapAllBuildInfo BuildInfo -> BuildInfo
filterAutogenModuleBI PackageDescription
pkg_descr0
  where
    mapLib :: (Library -> Library) -> PackageDescription -> PackageDescription
mapLib Library -> Library
f PackageDescription
pkg =
      PackageDescription
pkg
        { library = fmap f (library pkg)
        , subLibraries = map f (subLibraries pkg)
        }
    filterAutogenModuleLib :: Library -> Library
filterAutogenModuleLib Library
lib =
      Library
lib
        { exposedModules = filter (filterFunction (libBuildInfo lib)) (exposedModules lib)
        }
    filterAutogenModuleBI :: BuildInfo -> BuildInfo
filterAutogenModuleBI BuildInfo
bi =
      BuildInfo
bi
        { otherModules = filter (filterFunction bi) (otherModules bi)
        }
    pathsModule :: ModuleName
pathsModule = PackageDescription -> ModuleName
autogenPathsModuleName PackageDescription
pkg_descr0
    packageInfoModule :: ModuleName
packageInfoModule = PackageDescription -> ModuleName
autogenPackageInfoModuleName PackageDescription
pkg_descr0
    filterFunction :: BuildInfo -> ModuleName -> Bool
filterFunction BuildInfo
bi = \ModuleName
mn ->
      ModuleName
mn ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= ModuleName
pathsModule
        Bool -> Bool -> Bool
&& ModuleName
mn ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= ModuleName
packageInfoModule
        Bool -> Bool -> Bool
&& Bool -> Bool
not (ModuleName
mn ModuleName -> [ModuleName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BuildInfo -> [ModuleName]
autogenModules BuildInfo
bi)

-- | 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
  -> FilePath
  -- ^ source tree to populate
  -> [PPSuffixHandler]
  -- ^ extra preprocessors (includes suffixes)
  -> IO ()
prepareSnapshotTree :: Verbosity
-> PackageDescription -> FilePath -> [PPSuffixHandler] -> IO ()
prepareSnapshotTree Verbosity
verbosity PackageDescription
pkg FilePath
targetDir [PPSuffixHandler]
pps = do
  Verbosity
-> PackageDescription -> FilePath -> [PPSuffixHandler] -> IO ()
prepareTree Verbosity
verbosity PackageDescription
pkg FilePath
targetDir [PPSuffixHandler]
pps
  Verbosity -> PackageDescription -> FilePath -> IO ()
overwriteSnapshotPackageDesc Verbosity
verbosity PackageDescription
pkg FilePath
targetDir

overwriteSnapshotPackageDesc
  :: Verbosity
  -- ^ verbosity
  -> PackageDescription
  -- ^ info from the cabal file
  -> FilePath
  -- ^ source tree
  -> IO ()
overwriteSnapshotPackageDesc :: Verbosity -> PackageDescription -> FilePath -> IO ()
overwriteSnapshotPackageDesc Verbosity
verbosity PackageDescription
pkg FilePath
targetDir = do
  -- We could just writePackageDescription targetDescFile pkg_descr,
  -- but that would lose comments and formatting.
  descFile <- Verbosity -> IO FilePath
defaultPackageDesc Verbosity
verbosity
  withUTF8FileContents descFile $
    writeUTF8File (targetDir </> descFile)
      . unlines
      . map (replaceVersion (packageVersion pkg))
      . lines
  where
    replaceVersion :: Version -> String -> String
    replaceVersion :: Version -> FilePath -> FilePath
replaceVersion Version
version FilePath
line
      | FilePath
"version:" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
line =
          FilePath
"version: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
version
      | Bool
otherwise = FilePath
line

-- | Modifies a 'PackageDescription' by appending a snapshot number
-- corresponding to the given date.
snapshotPackage :: UTCTime -> PackageDescription -> PackageDescription
snapshotPackage :: UTCTime -> PackageDescription -> PackageDescription
snapshotPackage UTCTime
date PackageDescription
pkg =
  PackageDescription
pkg
    { package = pkgid{pkgVersion = snapshotVersion date (pkgVersion pkgid)}
    }
  where
    pkgid :: PackageIdentifier
pkgid = PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg

-- | Modifies a 'Version' by appending a snapshot number corresponding
-- to the given date.
snapshotVersion :: UTCTime -> Version -> Version
snapshotVersion :: UTCTime -> Version -> Version
snapshotVersion UTCTime
date = ([Int] -> [Int]) -> Version -> Version
alterVersion ([Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [UTCTime -> Int
dateToSnapshotNumber UTCTime
date])

-- | Given a date produce a corresponding integer representation.
-- For example given a date @18/03/2008@ produce the number @20080318@.
dateToSnapshotNumber :: UTCTime -> Int
dateToSnapshotNumber :: UTCTime -> Int
dateToSnapshotNumber UTCTime
date = case Day -> (Year, Int, Int)
toGregorian (UTCTime -> Day
utctDay UTCTime
date) of
  (Year
year, Int
month, Int
day) ->
    Year -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Year
year Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10000
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
month Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
day

-- | Create an archive from a tree of source files, and clean up the tree.
createArchive
  :: Verbosity
  -- ^ verbosity
  -> PackageDescription
  -- ^ info from cabal file
  -> FilePath
  -- ^ source tree to archive
  -> FilePath
  -- ^ name of archive to create
  -> IO FilePath
createArchive :: Verbosity
-> PackageDescription -> FilePath -> FilePath -> IO FilePath
createArchive Verbosity
verbosity PackageDescription
pkg_descr FilePath
tmpDir FilePath
targetPref = do
  let tarBallFilePath :: FilePath
tarBallFilePath = FilePath
targetPref FilePath -> FilePath -> FilePath
</> PackageDescription -> FilePath
tarBallName PackageDescription
pkg_descr FilePath -> FilePath -> FilePath
<.> FilePath
"tar.gz"
  (tarProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
tarProgram ProgramDb
defaultProgramDb
  let formatOptSupported =
        Bool -> (FilePath -> Bool) -> Maybe FilePath -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"YES") (Maybe FilePath -> Bool) -> Maybe FilePath -> Bool
forall a b. (a -> b) -> a -> b
$
          FilePath -> Map FilePath FilePath -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup
            FilePath
"Supports --format"
            (ConfiguredProgram -> Map FilePath FilePath
programProperties ConfiguredProgram
tarProg)
  runProgram verbosity tarProg $
    -- 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.]
    ["-czf", tarBallFilePath, "-C", tmpDir]
      ++ (if formatOptSupported then ["--format", "ustar"] else [])
      ++ [tarBallName pkg_descr]
  return tarBallFilePath

-- | Given a buildinfo, return the names of all source files.
allSourcesBuildInfo
  :: Verbosity
  -> (Verbosity -> CabalException -> IO [FilePath])
  -- ^ 'die'' alternative.
  -- Since 'die'' prefixes the error message with 'errorPrefix',
  -- whatever is passed in here and wants to die should do the same.
  -- See issue #7331.
  -> FilePath
  -- ^ cwd -- change me to 'BuildPath Absolute PackageDir'
  -> BuildInfo
  -> [PPSuffixHandler]
  -- ^ Extra preprocessors
  -> [ModuleName]
  -- ^ Exposed modules
  -> IO [FilePath]
allSourcesBuildInfo :: Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd BuildInfo
bi [PPSuffixHandler]
pps [ModuleName]
modules = do
  let searchDirs :: [FilePath]
searchDirs = (SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)
  sources <-
    ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[FilePath]] -> IO [FilePath])
-> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
      [IO [FilePath]] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([IO [FilePath]] -> IO [[FilePath]])
-> [IO [FilePath]] -> IO [[FilePath]]
forall a b. (a -> b) -> a -> b
$
        [ let file :: FilePath
file = ModuleName -> FilePath
ModuleName.toFilePath ModuleName
module_
           in -- 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.
              FilePath -> [Suffix] -> [FilePath] -> FilePath -> IO [FilePath]
findAllFilesCwdWithExtension FilePath
cwd [Suffix]
suffixes [FilePath]
searchDirs FilePath
file
                IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO [FilePath]
-> ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall b a. b -> ([a] -> b) -> [a] -> b
nonEmpty' (ModuleName -> IO [FilePath]
notFound ModuleName
module_) [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
        | ModuleName
module_ <- [ModuleName]
modules [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
otherModules BuildInfo
bi
        ]
  bootFiles <-
    sequenceA
      [ let file = ModuleName -> FilePath
ModuleName.toFilePath ModuleName
module_
            fileExts = [Suffix]
builtinHaskellBootSuffixes
         in findFileCwdWithExtension cwd fileExts (map getSymbolicPath (hsSourceDirs bi)) file
      | module_ <- modules ++ otherModules bi
      ]

  return $
    sources
      ++ catMaybes bootFiles
      ++ cSources bi
      ++ cxxSources bi
      ++ cmmSources bi
      ++ asmSources bi
      ++ jsSources bi
  where
    nonEmpty' :: b -> ([a] -> b) -> [a] -> b
    nonEmpty' :: forall b a. b -> ([a] -> b) -> [a] -> b
nonEmpty' b
x [a] -> b
_ [] = b
x
    nonEmpty' b
_ [a] -> b
f [a]
xs = [a] -> b
f [a]
xs

    suffixes :: [Suffix]
suffixes = [PPSuffixHandler] -> [Suffix]
ppSuffixes [PPSuffixHandler]
pps [Suffix] -> [Suffix] -> [Suffix]
forall a. [a] -> [a] -> [a]
++ [Suffix]
builtinHaskellSuffixes

    notFound :: ModuleName -> IO [FilePath]
    notFound :: ModuleName -> IO [FilePath]
notFound ModuleName
m =
      Verbosity -> CabalException -> IO [FilePath]
rip Verbosity
verbosity (CabalException -> IO [FilePath])
-> CabalException -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ ModuleName -> [Suffix] -> CabalException
NoModuleFound ModuleName
m [Suffix]
suffixes

-- | Note: must be called with the CWD set to the directory containing
-- the '.cabal' file.
printPackageProblems :: Verbosity -> PackageDescription -> IO ()
printPackageProblems :: Verbosity -> PackageDescription -> IO ()
printPackageProblems Verbosity
verbosity PackageDescription
pkg_descr = do
  ioChecks <- Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck]
checkPackageFiles Verbosity
verbosity PackageDescription
pkg_descr FilePath
"."
  let pureChecks = PackageDescription -> [PackageCheck]
checkConfiguredPackage PackageDescription
pkg_descr
      (errors, warnings) = partition isHackageDistError (pureChecks ++ ioChecks)
  unless (null errors) $
    notice verbosity $
      "Distribution quality errors:\n"
        ++ unlines (map ppPackageCheck errors)
  unless (null warnings) $
    notice verbosity $
      "Distribution quality warnings:\n"
        ++ unlines (map ppPackageCheck warnings)
  unless (null errors) $
    notice
      verbosity
      "Note: the public hackage server would reject this package."

------------------------------------------------------------

-- | The name of the tarball without extension
tarBallName :: PackageDescription -> String
tarBallName :: PackageDescription -> FilePath
tarBallName = PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageIdentifier -> FilePath)
-> (PackageDescription -> PackageIdentifier)
-> PackageDescription
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId

mapAllBuildInfo
  :: (BuildInfo -> BuildInfo)
  -> (PackageDescription -> PackageDescription)
mapAllBuildInfo :: (BuildInfo -> BuildInfo)
-> PackageDescription -> PackageDescription
mapAllBuildInfo BuildInfo -> BuildInfo
f PackageDescription
pkg =
  PackageDescription
pkg
    { library = fmap mapLibBi (library pkg)
    , subLibraries = fmap mapLibBi (subLibraries pkg)
    , foreignLibs = fmap mapFLibBi (foreignLibs pkg)
    , executables = fmap mapExeBi (executables pkg)
    , testSuites = fmap mapTestBi (testSuites pkg)
    , benchmarks = fmap mapBenchBi (benchmarks pkg)
    }
  where
    mapLibBi :: Library -> Library
mapLibBi Library
lib = Library
lib{libBuildInfo = f (libBuildInfo lib)}
    mapFLibBi :: ForeignLib -> ForeignLib
mapFLibBi ForeignLib
flib = ForeignLib
flib{foreignLibBuildInfo = f (foreignLibBuildInfo flib)}
    mapExeBi :: Executable -> Executable
mapExeBi Executable
exe = Executable
exe{buildInfo = f (buildInfo exe)}
    mapTestBi :: TestSuite -> TestSuite
mapTestBi TestSuite
tst = TestSuite
tst{testBuildInfo = f (testBuildInfo tst)}
    mapBenchBi :: Benchmark -> Benchmark
mapBenchBi Benchmark
bm = Benchmark
bm{benchmarkBuildInfo = f (benchmarkBuildInfo bm)}