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

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

    -- 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 (
      -- * The top level action
      sdist,

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

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

      -- * Extracting the source files
      listPackageSources,
      listPackageSourcesWithDie,

      )  where

    import Prelude ()
    import Distribution.Compat.Prelude

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

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

    -- |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 -> (String -> String) -> [PPSuffixHandler] -> IO ()
    sdist PackageDescription
    pkg SDistFlags
    flags String -> String
    mkTmpDir [PPSuffixHandler]
    pps = do

      String
    distPref <- Flag String -> IO String
    findDistPrefOrDefault (Flag String -> IO String) -> Flag String -> IO String
    forall a b. (a -> b) -> a -> b
    $ SDistFlags -> Flag String
    sDistDistPref SDistFlags
    flags
      let targetPref :: String
    targetPref   = String
    distPref
          tmpTargetDir :: String
    tmpTargetDir = String -> String
    mkTmpDir String
    distPref

      -- When given --list-sources, just output the list of sources to a file.
      case SDistFlags -> Flag String
    sDistListSources SDistFlags
    flags of
        Flag String
    path -> String -> IOMode -> (Handle -> IO ()) -> IO ()
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withFile String
    path IOMode
    WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    outHandle -> do
          [String]
    ordinary <- Verbosity
    -> String -> PackageDescription -> [PPSuffixHandler] -> IO [String]
    listPackageSources Verbosity
    verbosity String
    "." PackageDescription
    pkg [PPSuffixHandler]
    pps
          (String -> IO ()) -> [String] -> IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ (Handle -> String -> IO ()
    hPutStrLn Handle
    outHandle) [String]
    ordinary
          Verbosity -> String -> IO ()
    notice Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "List of package sources written to file '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    path String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'"

        Flag String
    NoFlag    -> do
          -- do some QA
          Verbosity -> PackageDescription -> IO ()
    printPackageProblems Verbosity
    verbosity PackageDescription
    pkg

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

          case Flag String -> Maybe String
    forall a. Flag a -> Maybe a
    flagToMaybe (SDistFlags -> Flag String
    sDistDirectory SDistFlags
    flags) of
            Just String
    targetDir -> do
              String -> PackageDescription -> IO ()
    generateSourceDir String
    targetDir PackageDescription
    pkg'
              Verbosity -> String -> IO ()
    info Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Source directory created: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    targetDir

            Maybe String
    Nothing -> do
              Verbosity -> Bool -> String -> IO ()
    createDirectoryIfMissingVerbose Verbosity
    verbosity Bool
    True String
    tmpTargetDir
              Verbosity -> String -> String -> (String -> IO ()) -> IO ()
    forall a. Verbosity -> String -> String -> (String -> IO a) -> IO a
    withTempDirectory Verbosity
    verbosity String
    tmpTargetDir String
    "sdist." ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \String
    tmpDir -> do
                let targetDir :: String
    targetDir = String
    tmpDir String -> String -> String
    </> PackageDescription -> String
    tarBallName PackageDescription
    pkg'
                String -> PackageDescription -> IO ()
    generateSourceDir String
    targetDir PackageDescription
    pkg'
                String
    targzFile <- Verbosity -> PackageDescription -> String -> String -> IO String
    createArchive Verbosity
    verbosity PackageDescription
    pkg' String
    tmpDir String
    targetPref
                Verbosity -> String -> IO ()
    notice Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Source tarball created: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    targzFile

      where
        generateSourceDir :: FilePath -> PackageDescription -> IO ()
        generateSourceDir :: String -> PackageDescription -> IO ()
    generateSourceDir String
    targetDir PackageDescription
    pkg' = do
          Verbosity -> String -> PackageIdentifier -> IO ()
    setupMessage Verbosity
    verbosity String
    "Building source dist for" (PackageDescription -> PackageIdentifier
    forall pkg. Package pkg => pkg -> PackageIdentifier
    packageId PackageDescription
    pkg')
          Verbosity
    -> PackageDescription -> String -> [PPSuffixHandler] -> IO ()
    prepareTree Verbosity
    verbosity PackageDescription
    pkg' String
    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 -> String -> IO ()
    overwriteSnapshotPackageDesc Verbosity
    verbosity PackageDescription
    pkg' String
    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
    -> String -> PackageDescription -> [PPSuffixHandler] -> IO [String]
    listPackageSources Verbosity
    verbosity String
    cwd PackageDescription
    pkg_descr0 [PPSuffixHandler]
    pps = do
        -- Call helpers that actually do all work.
        Verbosity
    -> (Verbosity -> String -> IO [String])
    -> String
    -> PackageDescription
    -> [PPSuffixHandler]
    -> IO [String]
    listPackageSources' Verbosity
    verbosity Verbosity -> String -> IO [String]
    forall a. Verbosity -> String -> IO a
    die' String
    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 -> String -> 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 -> String -> IO [String])
    -> String
    -> PackageDescription
    -> [PPSuffixHandler]
    -> IO [String]
    listPackageSourcesWithDie Verbosity
    verbosity Verbosity -> String -> IO [String]
    rip String
    cwd PackageDescription
    pkg_descr0 [PPSuffixHandler]
    pps = do
        -- Call helpers that actually do all work.
        Verbosity
    -> (Verbosity -> String -> IO [String])
    -> String
    -> PackageDescription
    -> [PPSuffixHandler]
    -> IO [String]
    listPackageSources' Verbosity
    verbosity Verbosity -> String -> IO [String]
    rip String
    cwd PackageDescription
    pkg_descr [PPSuffixHandler]
    pps
      where
        pkg_descr :: PackageDescription
    pkg_descr = PackageDescription -> PackageDescription
    filterAutogenModules PackageDescription
    pkg_descr0

    listPackageSources'
      :: Verbosity
           -- ^ verbosity
      -> (Verbosity -> String -> 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 -> String -> IO [String])
    -> String
    -> PackageDescription
    -> [PPSuffixHandler]
    -> IO [String]
    listPackageSources' Verbosity
    verbosity Verbosity -> String -> IO [String]
    rip String
    cwd PackageDescription
    pkg_descr [PPSuffixHandler]
    pps =
      ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (IO [[String]] -> IO [String])
    -> ([IO [String]] -> IO [[String]]) -> [IO [String]] -> IO [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [IO [String]] -> IO [[String]]
    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 [String]] -> IO [String]) -> [IO [String]] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $
      [
        -- Library sources.
        ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        (IO [[String]] -> IO [String])
    -> ((Library -> IO [String]) -> IO [[String]])
    -> (Library -> IO [String])
    -> IO [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Library -> IO [String]) -> IO [[String]]
    forall {f :: * -> *} {b}.
    Applicative f =>
    (Library -> f b) -> f [b]
    withAllLib ((Library -> IO [String]) -> IO [String])
    -> (Library -> IO [String]) -> IO [String]
    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 -> String -> IO [String])
    -> String
    -> BuildInfo
    -> [PPSuffixHandler]
    -> [ModuleName]
    -> IO [String]
    allSourcesBuildInfo Verbosity
    verbosity Verbosity -> String -> IO [String]
    rip String
    cwd BuildInfo
    libBi [PPSuffixHandler]
    pps ([ModuleName]
    modules [ModuleName] -> [ModuleName] -> [ModuleName]
    forall a. [a] -> [a] -> [a]
    ++ [ModuleName]
    sigs)

        -- Executables sources.
      , ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        (IO [[String]] -> IO [String])
    -> ((Executable -> IO [String]) -> IO [[String]])
    -> (Executable -> IO [String])
    -> IO [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Executable -> IO [String]) -> IO [[String]]
    forall {f :: * -> *} {b}.
    Applicative f =>
    (Executable -> f b) -> f [b]
    withAllExe ((Executable -> IO [String]) -> IO [String])
    -> (Executable -> IO [String]) -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ \Executable { modulePath :: Executable -> String
    modulePath = String
    mainPath, buildInfo :: Executable -> BuildInfo
    buildInfo = BuildInfo
    exeBi } -> do
           [String]
    biSrcs  <- Verbosity
    -> (Verbosity -> String -> IO [String])
    -> String
    -> BuildInfo
    -> [PPSuffixHandler]
    -> [ModuleName]
    -> IO [String]
    allSourcesBuildInfo Verbosity
    verbosity Verbosity -> String -> IO [String]
    rip String
    cwd BuildInfo
    exeBi [PPSuffixHandler]
    pps []
           String
    mainSrc <- Verbosity
    -> String -> BuildInfo -> [PPSuffixHandler] -> String -> IO String
    findMainExeFile Verbosity
    verbosity String
    cwd BuildInfo
    exeBi [PPSuffixHandler]
    pps String
    mainPath
           [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    mainSrcString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    biSrcs)

        -- Foreign library sources
      , ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        (IO [[String]] -> IO [String])
    -> ((ForeignLib -> IO [String]) -> IO [[String]])
    -> (ForeignLib -> IO [String])
    -> IO [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ForeignLib -> IO [String]) -> IO [[String]]
    forall {f :: * -> *} {b}.
    Applicative f =>
    (ForeignLib -> f b) -> f [b]
    withAllFLib ((ForeignLib -> IO [String]) -> IO [String])
    -> (ForeignLib -> IO [String]) -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ \flib :: ForeignLib
    flib@(ForeignLib { foreignLibBuildInfo :: ForeignLib -> BuildInfo
    foreignLibBuildInfo = BuildInfo
    flibBi }) -> do
           [String]
    biSrcs   <- Verbosity
    -> (Verbosity -> String -> IO [String])
    -> String
    -> BuildInfo
    -> [PPSuffixHandler]
    -> [ModuleName]
    -> IO [String]
    allSourcesBuildInfo Verbosity
    verbosity Verbosity -> String -> IO [String]
    rip String
    cwd BuildInfo
    flibBi [PPSuffixHandler]
    pps []
           [String]
    defFiles <- (String -> IO String) -> [String] -> IO [String]
    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 (Verbosity
    -> String -> BuildInfo -> [PPSuffixHandler] -> String -> IO String
    findModDefFile Verbosity
    verbosity String
    cwd BuildInfo
    flibBi [PPSuffixHandler]
    pps)
             (ForeignLib -> [String]
    foreignLibModDefFile ForeignLib
    flib)
           [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String]
    defFiles [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    biSrcs)

        -- Test suites sources.
      , ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        (IO [[String]] -> IO [String])
    -> ((TestSuite -> IO [String]) -> IO [[String]])
    -> (TestSuite -> IO [String])
    -> IO [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TestSuite -> IO [String]) -> IO [[String]]
    forall {f :: * -> *} {b}.
    Applicative f =>
    (TestSuite -> f b) -> f [b]
    withAllTest ((TestSuite -> IO [String]) -> IO [String])
    -> (TestSuite -> IO [String]) -> IO [String]
    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
    _ String
    mainPath -> do
               [String]
    biSrcs <- Verbosity
    -> (Verbosity -> String -> IO [String])
    -> String
    -> BuildInfo
    -> [PPSuffixHandler]
    -> [ModuleName]
    -> IO [String]
    allSourcesBuildInfo Verbosity
    verbosity Verbosity -> String -> IO [String]
    rip String
    cwd BuildInfo
    bi [PPSuffixHandler]
    pps []
               String
    srcMainFile <- Verbosity
    -> String -> BuildInfo -> [PPSuffixHandler] -> String -> IO String
    findMainExeFile Verbosity
    verbosity String
    cwd BuildInfo
    bi [PPSuffixHandler]
    pps String
    mainPath
               [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    srcMainFileString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    biSrcs)
             TestSuiteLibV09 Version
    _ ModuleName
    m ->
               Verbosity
    -> (Verbosity -> String -> IO [String])
    -> String
    -> BuildInfo
    -> [PPSuffixHandler]
    -> [ModuleName]
    -> IO [String]
    allSourcesBuildInfo Verbosity
    verbosity Verbosity -> String -> IO [String]
    rip String
    cwd BuildInfo
    bi [PPSuffixHandler]
    pps [ModuleName
    m]
             TestSuiteUnsupported TestType
    tp ->
               Verbosity -> String -> IO [String]
    rip Verbosity
    verbosity (String -> IO [String]) -> String -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ String
    "Unsupported test suite type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ TestType -> String
    forall a. Show a => a -> String
    show TestType
    tp

        -- Benchmarks sources.
      , ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        (IO [[String]] -> IO [String])
    -> ((Benchmark -> IO [String]) -> IO [[String]])
    -> (Benchmark -> IO [String])
    -> IO [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Benchmark -> IO [String]) -> IO [[String]]
    forall {f :: * -> *} {b}.
    Applicative f =>
    (Benchmark -> f b) -> f [b]
    withAllBenchmark ((Benchmark -> IO [String]) -> IO [String])
    -> (Benchmark -> IO [String]) -> IO [String]
    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
    _ String
    mainPath -> do
               [String]
    biSrcs <- Verbosity
    -> (Verbosity -> String -> IO [String])
    -> String
    -> BuildInfo
    -> [PPSuffixHandler]
    -> [ModuleName]
    -> IO [String]
    allSourcesBuildInfo Verbosity
    verbosity Verbosity -> String -> IO [String]
    rip String
    cwd BuildInfo
    bi [PPSuffixHandler]
    pps []
               String
    srcMainFile <- Verbosity
    -> String -> BuildInfo -> [PPSuffixHandler] -> String -> IO String
    findMainExeFile Verbosity
    verbosity String
    cwd BuildInfo
    bi [PPSuffixHandler]
    pps String
    mainPath
               [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    srcMainFileString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    biSrcs)
             BenchmarkUnsupported BenchmarkType
    tp ->
                Verbosity -> String -> IO [String]
    rip Verbosity
    verbosity (String -> IO [String]) -> String -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ String
    "Unsupported benchmark type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ BenchmarkType -> String
    forall a. Show a => a -> String
    show BenchmarkType
    tp

        -- Data files.
      , ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        (IO [[String]] -> IO [String])
    -> ((String -> IO [String]) -> IO [[String]])
    -> (String -> IO [String])
    -> IO [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> (String -> IO [String]) -> IO [[String]]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for (PackageDescription -> [String]
    dataFiles PackageDescription
    pkg_descr) ((String -> IO [String]) -> IO [String])
    -> (String -> IO [String]) -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ \String
    filename -> do
            let srcDataDirRaw :: String
    srcDataDirRaw                   = PackageDescription -> String
    dataDir PackageDescription
    pkg_descr
                srcDataDir :: String
    srcDataDir | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    srcDataDirRaw = String
    "."
                           | Bool
    otherwise          = String
    srcDataDirRaw
            Verbosity
    -> (Verbosity -> String -> IO [String])
    -> CabalSpecVersion
    -> String
    -> String
    -> IO [String]
    matchDirFileGlobWithDie Verbosity
    verbosity Verbosity -> String -> IO [String]
    rip (PackageDescription -> CabalSpecVersion
    specVersion PackageDescription
    pkg_descr) String
    cwd (String
    srcDataDir String -> String -> String
    </> String
    filename)

        -- Extra source files.
      , ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (IO [[String]] -> IO [String])
    -> ((String -> IO [String]) -> IO [[String]])
    -> (String -> IO [String])
    -> IO [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> (String -> IO [String]) -> IO [[String]]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for (PackageDescription -> [String]
    extraSrcFiles PackageDescription
    pkg_descr) ((String -> IO [String]) -> IO [String])
    -> (String -> IO [String]) -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ \String
    fpath ->
        Verbosity
    -> (Verbosity -> String -> IO [String])
    -> CabalSpecVersion
    -> String
    -> String
    -> IO [String]
    matchDirFileGlobWithDie Verbosity
    verbosity Verbosity -> String -> IO [String]
    rip (PackageDescription -> CabalSpecVersion
    specVersion PackageDescription
    pkg_descr) String
    cwd String
    fpath

        -- Extra doc files.
      , ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        (IO [[String]] -> IO [String])
    -> ((String -> IO [String]) -> IO [[String]])
    -> (String -> IO [String])
    -> IO [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> (String -> IO [String]) -> IO [[String]]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for (PackageDescription -> [String]
    extraDocFiles PackageDescription
    pkg_descr) ((String -> IO [String]) -> IO [String])
    -> (String -> IO [String]) -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ \ String
    filename ->
            Verbosity
    -> (Verbosity -> String -> IO [String])
    -> CabalSpecVersion
    -> String
    -> String
    -> IO [String]
    matchDirFileGlobWithDie Verbosity
    verbosity Verbosity -> String -> IO [String]
    rip (PackageDescription -> CabalSpecVersion
    specVersion PackageDescription
    pkg_descr) String
    cwd String
    filename

        -- License file(s).
      , [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((SymbolicPath PackageDir LicenseFile -> String)
    -> [SymbolicPath PackageDir LicenseFile] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map SymbolicPath PackageDir LicenseFile -> String
    forall from to. SymbolicPath from to -> String
    getSymbolicPath ([SymbolicPath PackageDir LicenseFile] -> [String])
    -> [SymbolicPath PackageDir LicenseFile] -> [String]
    forall a b. (a -> b) -> a -> b
    $ PackageDescription -> [SymbolicPath PackageDir LicenseFile]
    licenseFiles PackageDescription
    pkg_descr)

        -- Install-include files, without autogen-include files
      , ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        (IO [[String]] -> IO [String])
    -> ((Library -> IO [String]) -> IO [[String]])
    -> (Library -> IO [String])
    -> IO [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Library -> IO [String]) -> IO [[String]]
    forall {f :: * -> *} {b}.
    Applicative f =>
    (Library -> f b) -> f [b]
    withAllLib ((Library -> IO [String]) -> IO [String])
    -> (Library -> IO [String]) -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ \ Library
    l -> do
           let lbi :: BuildInfo
    lbi   = Library -> BuildInfo
    libBuildInfo Library
    l
               incls :: [String]
    incls = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` BuildInfo -> [String]
    autogenIncludes BuildInfo
    lbi) (BuildInfo -> [String]
    installIncludes BuildInfo
    lbi)
               relincdirs :: [String]
    relincdirs = String
    "." String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    isRelative (BuildInfo -> [String]
    includeDirs BuildInfo
    lbi)
           (String -> IO String) -> [String] -> IO [String]
    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 (((String, String) -> String) -> IO (String, String) -> IO String
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String, String) -> String
    forall a b. (a, b) -> b
    snd (IO (String, String) -> IO String)
    -> (String -> IO (String, String)) -> String -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Verbosity -> String -> [String] -> String -> IO (String, String)
    findIncludeFile Verbosity
    verbosity String
    cwd [String]
    relincdirs) [String]
    incls

        -- Setup script, if it exists.
      , (Maybe String -> [String]) -> IO (Maybe String) -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([String] -> (String -> [String]) -> Maybe String -> [String]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\String
    f -> [String
    f])) (IO (Maybe String) -> IO [String])
    -> IO (Maybe String) -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ String -> IO (Maybe String)
    findSetupFile String
    cwd

        -- The .cabal file itself.
      , (String -> [String]) -> IO String -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\String
    d -> [String
    d]) (Verbosity -> String -> String -> IO String
    tryFindPackageDescCwd Verbosity
    verbosity String
    cwd String
    ".")

      ]
      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 -> String -> [PPSuffixHandler] -> IO ()
    prepareTree Verbosity
    verbosity PackageDescription
    pkg_descr0 String
    targetDir [PPSuffixHandler]
    pps = do
        [String]
    ordinary <- Verbosity
    -> String -> PackageDescription -> [PPSuffixHandler] -> IO [String]
    listPackageSources Verbosity
    verbosity String
    "." PackageDescription
    pkg_descr [PPSuffixHandler]
    pps
        Verbosity -> String -> [(String, String)] -> IO ()
    installOrdinaryFiles Verbosity
    verbosity String
    targetDir ([String] -> [String] -> [(String, String)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (String -> [String]
    forall a. a -> [a]
    repeat []) [String]
    ordinary)
        String -> IO ()
    maybeCreateDefaultSetupScript String
    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 :: String -> IO (Maybe String)
    findSetupFile String
    targetDir = do
      Bool
    hsExists  <- String -> IO Bool
    doesFileExist (String
    targetDir String -> String -> String
    </> String
    setupHs)
      Bool
    lhsExists <- String -> IO Bool
    doesFileExist (String
    targetDir String -> String -> String
    </> String
    setupLhs)
      if Bool
    hsExists
        then Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    setupHs)
        else if Bool
    lhsExists
             then Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    setupLhs)
             else Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe String
    forall a. Maybe a
    Nothing
        where
          setupHs :: String
    setupHs  = String
    "Setup.hs"
          setupLhs :: String
    setupLhs = String
    "Setup.lhs"

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

    -- | Find the main executable file.
    findMainExeFile
      :: Verbosity
      -> FilePath -- ^ cwd
      -> BuildInfo
      -> [PPSuffixHandler]
      -> FilePath -- ^ main-is
      -> IO FilePath
    findMainExeFile :: Verbosity
    -> String -> BuildInfo -> [PPSuffixHandler] -> String -> IO String
    findMainExeFile Verbosity
    verbosity String
    cwd BuildInfo
    exeBi [PPSuffixHandler]
    pps String
    mainPath = do
      Maybe String
    ppFile <- String -> [String] -> [String] -> String -> IO (Maybe String)
    findFileCwdWithExtension String
    cwd ([PPSuffixHandler] -> [String]
    ppSuffixes [PPSuffixHandler]
    pps) ((SymbolicPath PackageDir SourceDir -> String)
    -> [SymbolicPath PackageDir SourceDir] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map SymbolicPath PackageDir SourceDir -> String
    forall from to. SymbolicPath from to -> String
    getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
    hsSourceDirs BuildInfo
    exeBi))
                (String -> String
    dropExtension String
    mainPath)
      case Maybe String
    ppFile of
        Maybe String
    Nothing -> Verbosity -> String -> [String] -> String -> IO String
    findFileCwd Verbosity
    verbosity String
    cwd ((SymbolicPath PackageDir SourceDir -> String)
    -> [SymbolicPath PackageDir SourceDir] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map SymbolicPath PackageDir SourceDir -> String
    forall from to. SymbolicPath from to -> String
    getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
    hsSourceDirs BuildInfo
    exeBi)) String
    mainPath
        Just String
    pp -> String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    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
    -> String -> BuildInfo -> [PPSuffixHandler] -> String -> IO String
    findModDefFile Verbosity
    verbosity String
    cwd BuildInfo
    flibBi [PPSuffixHandler]
    _pps String
    modDefPath =
        Verbosity -> String -> [String] -> String -> IO String
    findFileCwd Verbosity
    verbosity String
    cwd (String
    "." String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (SymbolicPath PackageDir SourceDir -> String)
    -> [SymbolicPath PackageDir SourceDir] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map SymbolicPath PackageDir SourceDir -> String
    forall from to. SymbolicPath from to -> String
    getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
    hsSourceDirs BuildInfo
    flibBi)) String
    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 -> String -> [String] -> String -> IO (String, String)
    findIncludeFile Verbosity
    verbosity String
    _ [] String
    f = Verbosity -> String -> IO (String, String)
    forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity (String
    "can't find include file " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    f)
    findIncludeFile Verbosity
    verbosity String
    cwd (String
    d:[String]
    ds) String
    f = do
      let path :: String
    path = (String
    d String -> String -> String
    </> String
    f)
      Bool
    b <- String -> IO Bool
    doesFileExist (String
    cwd String -> String -> String
    </> String
    path)
      if Bool
    b then (String, String) -> IO (String, String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    f,String
    path) else Verbosity -> String -> [String] -> String -> IO (String, String)
    findIncludeFile Verbosity
    verbosity String
    cwd [String]
    ds String
    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 -> String -> [PPSuffixHandler] -> IO ()
    prepareSnapshotTree Verbosity
    verbosity PackageDescription
    pkg String
    targetDir [PPSuffixHandler]
    pps = do
      Verbosity
    -> PackageDescription -> String -> [PPSuffixHandler] -> IO ()
    prepareTree Verbosity
    verbosity PackageDescription
    pkg String
    targetDir [PPSuffixHandler]
    pps
      Verbosity -> PackageDescription -> String -> IO ()
    overwriteSnapshotPackageDesc Verbosity
    verbosity PackageDescription
    pkg String
    targetDir

    overwriteSnapshotPackageDesc :: Verbosity          -- ^verbosity
                                 -> PackageDescription -- ^info from the cabal file
                                 -> FilePath           -- ^source tree
                                 -> IO ()
    overwriteSnapshotPackageDesc :: Verbosity -> PackageDescription -> String -> IO ()
    overwriteSnapshotPackageDesc Verbosity
    verbosity PackageDescription
    pkg String
    targetDir = do
        -- We could just writePackageDescription targetDescFile pkg_descr,
        -- but that would lose comments and formatting.
        String
    descFile <- Verbosity -> IO String
    defaultPackageDesc Verbosity
    verbosity
        String -> (String -> IO ()) -> IO ()
    forall a. String -> (String -> IO a) -> IO a
    withUTF8FileContents String
    descFile ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          String -> String -> IO ()
    writeUTF8File (String
    targetDir String -> String -> String
    </> String
    descFile)
            (String -> IO ()) -> (String -> String) -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    unlines ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Version -> String -> String
    replaceVersion (PackageDescription -> Version
    forall pkg. Package pkg => pkg -> Version
    packageVersion PackageDescription
    pkg)) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines

      where
        replaceVersion :: Version -> String -> String
        replaceVersion :: Version -> String -> String
    replaceVersion Version
    version String
    line
          | String
    "version:" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    line
                      = String
    "version: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Version -> String
    forall a. Pretty a => a -> String
    prettyShow Version
    version
          | Bool
    otherwise = String
    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 -> String -> String -> IO String
    createArchive Verbosity
    verbosity PackageDescription
    pkg_descr String
    tmpDir String
    targetPref = do
      let tarBallFilePath :: String
    tarBallFilePath = String
    targetPref String -> String -> String
    </> PackageDescription -> String
    tarBallName PackageDescription
    pkg_descr String -> String -> String
    <.> String
    "tar.gz"
      (ConfiguredProgram
    tarProg, ProgramDb
    _) <- Verbosity
    -> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
    requireProgram Verbosity
    verbosity Program
    tarProgram ProgramDb
    defaultProgramDb
      let formatOptSupported :: Bool
    formatOptSupported = Bool -> (String -> Bool) -> Maybe String -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "YES") (Maybe String -> Bool) -> Maybe String -> Bool
    forall a b. (a -> b) -> a -> b
    $
                               String -> Map String String -> Maybe String
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup String
    "Supports --format"
                               (ConfiguredProgram -> Map String String
    programProperties ConfiguredProgram
    tarProg)
      Verbosity -> ConfiguredProgram -> [String] -> IO ()
    runProgram Verbosity
    verbosity ConfiguredProgram
    tarProg ([String] -> IO ()) -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        -- 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.]
        [String
    "-czf", String
    tarBallFilePath, String
    "-C", String
    tmpDir]
        [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (if Bool
    formatOptSupported then [String
    "--format", String
    "ustar"] else [])
        [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [PackageDescription -> String
    tarBallName PackageDescription
    pkg_descr]
      String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    tarBallFilePath

    -- | Given a buildinfo, return the names of all source files.
    allSourcesBuildInfo
        :: Verbosity
        -> (Verbosity -> String -> 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 -> String -> IO [String])
    -> String
    -> BuildInfo
    -> [PPSuffixHandler]
    -> [ModuleName]
    -> IO [String]
    allSourcesBuildInfo Verbosity
    verbosity Verbosity -> String -> IO [String]
    rip String
    cwd BuildInfo
    bi [PPSuffixHandler]
    pps [ModuleName]
    modules = do
      let searchDirs :: [String]
    searchDirs = (SymbolicPath PackageDir SourceDir -> String)
    -> [SymbolicPath PackageDir SourceDir] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map SymbolicPath PackageDir SourceDir -> String
    forall from to. SymbolicPath from to -> String
    getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
    hsSourceDirs BuildInfo
    bi)
      [String]
    sources <- ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (IO [[String]] -> IO [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ [IO [String]] -> IO [[String]]
    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 [String]] -> IO [[String]]) -> [IO [String]] -> IO [[String]]
    forall a b. (a -> b) -> a -> b
    $
        [ let file :: String
    file = ModuleName -> String
    ModuleName.toFilePath ModuleName
    module_
          -- 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.
          in String -> [String] -> [String] -> String -> IO [String]
    findAllFilesCwdWithExtension String
    cwd [String]
    suffixes [String]
    searchDirs String
    file
             IO [String] -> ([String] -> IO [String]) -> IO [String]
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO [String] -> ([String] -> IO [String]) -> [String] -> IO [String]
    forall b a. b -> ([a] -> b) -> [a] -> b
    nonEmpty' (ModuleName -> IO [String]
    notFound ModuleName
    module_) [String] -> IO [String]
    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 ]
      [Maybe String]
    bootFiles <- [IO (Maybe String)] -> IO [Maybe String]
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
    sequenceA
        [ let file :: String
    file = ModuleName -> String
    ModuleName.toFilePath ModuleName
    module_
              fileExts :: [String]
    fileExts = [String
    "hs-boot", String
    "lhs-boot"]
          in String -> [String] -> [String] -> String -> IO (Maybe String)
    findFileCwdWithExtension String
    cwd [String]
    fileExts ((SymbolicPath PackageDir SourceDir -> String)
    -> [SymbolicPath PackageDir SourceDir] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map SymbolicPath PackageDir SourceDir -> String
    forall from to. SymbolicPath from to -> String
    getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
    hsSourceDirs BuildInfo
    bi)) String
    file
        | ModuleName
    module_ <- [ModuleName]
    modules [ModuleName] -> [ModuleName] -> [ModuleName]
    forall a. [a] -> [a] -> [a]
    ++ BuildInfo -> [ModuleName]
    otherModules BuildInfo
    bi ]

      [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String] -> IO [String]) -> [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ [String]
    sources [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [Maybe String] -> [String]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe String]
    bootFiles [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ BuildInfo -> [String]
    cSources BuildInfo
    bi [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ BuildInfo -> [String]
    cxxSources BuildInfo
    bi [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
               BuildInfo -> [String]
    cmmSources BuildInfo
    bi [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ BuildInfo -> [String]
    asmSources BuildInfo
    bi [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ BuildInfo -> [String]
    jsSources BuildInfo
    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 :: [String]
    suffixes = [PPSuffixHandler] -> [String]
    ppSuffixes [PPSuffixHandler]
    pps [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    "hs", String
    "lhs", String
    "hsig", String
    "lhsig"]

        notFound :: ModuleName -> IO [FilePath]
        notFound :: ModuleName -> IO [String]
    notFound ModuleName
    m = Verbosity -> String -> IO [String]
    rip Verbosity
    verbosity (String -> IO [String]) -> String -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ String
    "Could not find module: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ModuleName -> String
    forall a. Pretty a => a -> String
    prettyShow ModuleName
    m
                     String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " with any suffix: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    forall a. Show a => a -> String
    show [String]
    suffixes String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ". If the module "
                     String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "is autogenerated it should be added to 'autogen-modules'."

    -- | 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
      [PackageCheck]
    ioChecks      <- Verbosity -> PackageDescription -> String -> IO [PackageCheck]
    checkPackageFiles Verbosity
    verbosity PackageDescription
    pkg_descr String
    "."
      let pureChecks :: [PackageCheck]
    pureChecks = PackageDescription -> [PackageCheck]
    checkConfiguredPackage PackageDescription
    pkg_descr
          isDistError :: PackageCheck -> Bool
    isDistError (PackageDistSuspicious     CheckExplanation
    _) = Bool
    False
          isDistError (PackageDistSuspiciousWarn CheckExplanation
    _) = Bool
    False
          isDistError PackageCheck
    _                             = Bool
    True
          ([PackageCheck]
    errors, [PackageCheck]
    warnings) = (PackageCheck -> Bool)
    -> [PackageCheck] -> ([PackageCheck], [PackageCheck])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition PackageCheck -> Bool
    isDistError ([PackageCheck]
    pureChecks [PackageCheck] -> [PackageCheck] -> [PackageCheck]
    forall a. [a] -> [a] -> [a]
    ++ [PackageCheck]
    ioChecks)
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([PackageCheck] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [PackageCheck]
    errors) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          Verbosity -> String -> IO ()
    notice Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Distribution quality errors:\n"
                          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unlines ((PackageCheck -> String) -> [PackageCheck] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map PackageCheck -> String
    ppPackageCheck [PackageCheck]
    errors)
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([PackageCheck] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [PackageCheck]
    warnings) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          Verbosity -> String -> IO ()
    notice Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Distribution quality warnings:\n"
                          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unlines ((PackageCheck -> String) -> [PackageCheck] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map PackageCheck -> String
    ppPackageCheck [PackageCheck]
    warnings)
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([PackageCheck] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [PackageCheck]
    errors) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          Verbosity -> String -> IO ()
    notice Verbosity
    verbosity
            String
    "Note: the public hackage server would reject this package."

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

    -- | The name of the tarball without extension
    --
    tarBallName :: PackageDescription -> String
    tarBallName :: PackageDescription -> String
    tarBallName = PackageIdentifier -> String
    forall a. Pretty a => a -> String
    prettyShow (PackageIdentifier -> String)
    -> (PackageDescription -> PackageIdentifier)
    -> PackageDescription
    -> String
    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) }