    {-# 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)}