{-# LANGUAGE DataKinds #-}
{-# 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 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.Errors
import Distribution.Simple.Flag
import Distribution.Simple.Glob (matchDirFileGlobWithDie)
import Distribution.Simple.PreProcess
import Distribution.Simple.Program
import Distribution.Simple.Setup.Common
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 System.Directory (doesFileExist)
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 -> ([Char] -> [Char]) -> [PPSuffixHandler] -> IO ()
sdist PackageDescription
pkg SDistFlags
flags [Char] -> [Char]
mkTmpDir [PPSuffixHandler]
pps = do
  distPref <- Flag (SymbolicPath Pkg ('Dir Dist))
-> IO (SymbolicPath Pkg ('Dir Dist))
findDistPrefOrDefault (Flag (SymbolicPath Pkg ('Dir Dist))
 -> IO (SymbolicPath Pkg ('Dir Dist)))
-> Flag (SymbolicPath Pkg ('Dir Dist))
-> IO (SymbolicPath Pkg ('Dir Dist))
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
setupDistPref CommonSetupFlags
common
  let targetPref = SymbolicPath Pkg ('Dir Dist) -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
i SymbolicPath Pkg ('Dir Dist)
distPref
      tmpTargetDir = [Char] -> [Char]
mkTmpDir (SymbolicPath Pkg ('Dir Dist) -> [Char]
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> [Char]
i SymbolicPath Pkg ('Dir Dist)
distPref)

  -- When given --list-sources, just output the list of sources to a file.
  case sDistListSources flags of
    Flag [Char]
path -> [Char] -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
path IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
outHandle -> do
      ordinary <- Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDescription
-> [PPSuffixHandler]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
listPackageSources Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir PackageDescription
pkg [PPSuffixHandler]
pps
      traverse_ (hPutStrLn outHandle . getSymbolicPath) ordinary
      notice verbosity $ "List of package sources written to file '" ++ path ++ "'"
    Flag [Char]
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 [Char]
targetDir -> do
          [Char] -> PackageDescription -> IO ()
generateSourceDir [Char]
targetDir PackageDescription
pkg'
          Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Source directory created: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
targetDir
        Maybe [Char]
Nothing -> do
          Verbosity -> Bool -> [Char] -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True [Char]
tmpTargetDir
          Verbosity -> [Char] -> [Char] -> ([Char] -> IO ()) -> IO ()
forall a. Verbosity -> [Char] -> [Char] -> ([Char] -> IO a) -> IO a
withTempDirectory Verbosity
verbosity [Char]
tmpTargetDir [Char]
"sdist." (([Char] -> IO ()) -> IO ()) -> ([Char] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
tmpDir -> do
            let targetDir :: [Char]
targetDir = [Char]
tmpDir [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> PackageDescription -> [Char]
tarBallName PackageDescription
pkg'
            [Char] -> PackageDescription -> IO ()
generateSourceDir [Char]
targetDir PackageDescription
pkg'
            targzFile <- Verbosity -> PackageDescription -> [Char] -> [Char] -> IO [Char]
createArchive Verbosity
verbosity PackageDescription
pkg' [Char]
tmpDir [Char]
targetPref
            notice verbosity $ "Source tarball created: " ++ targzFile
  where
    generateSourceDir :: FilePath -> PackageDescription -> IO ()
    generateSourceDir :: [Char] -> PackageDescription -> IO ()
generateSourceDir [Char]
targetDir PackageDescription
pkg' = do
      Verbosity -> [Char] -> PackageIdentifier -> IO ()
setupMessage Verbosity
verbosity [Char]
"Building source dist for" (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg')
      Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDescription
-> [Char]
-> [PPSuffixHandler]
-> IO ()
prepareTree Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir PackageDescription
pkg' [Char]
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 -> [Char] -> IO ()
overwriteSnapshotPackageDesc Verbosity
verbosity PackageDescription
pkg' [Char]
targetDir

    common :: CommonSetupFlags
common = SDistFlags -> CommonSetupFlags
sDistCommonFlags SDistFlags
flags
    verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag Verbosity
setupVerbosity CommonSetupFlags
common
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
 -> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
setupWorkingDir CommonSetupFlags
common
    i :: SymbolicPathX allowAbsolute Pkg to -> [Char]
i = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> [Char]
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> [Char]
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
    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
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ directory with cabal file
  -> PackageDescription
  -- ^ info from the cabal file
  -> [PPSuffixHandler]
  -- ^ extra preprocessors (include suffixes)
  -> IO [SymbolicPath Pkg File]
listPackageSources :: Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDescription
-> [PPSuffixHandler]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
listPackageSources Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
cwd PackageDescription
pkg_descr0 [PPSuffixHandler]
pps = do
  -- Call helpers that actually do all work.
  Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDescription
-> [PPSuffixHandler]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
listPackageSources' Verbosity
verbosity Verbosity -> CabalException -> IO [res]
forall res. Verbosity -> CabalException -> IO [res]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Maybe (SymbolicPath CWD ('Dir Pkg))
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
  -> (forall res. Verbosity -> CabalException -> IO [res])
  -- ^ '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.
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ directory with cabal file
  -> PackageDescription
  -- ^ info from the cabal file
  -> [PPSuffixHandler]
  -- ^ extra preprocessors (include suffixes)
  -> IO [SymbolicPath Pkg File]
listPackageSourcesWithDie :: Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDescription
-> [PPSuffixHandler]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
listPackageSourcesWithDie Verbosity
verbosity forall res. Verbosity -> CabalException -> IO [res]
rip Maybe (SymbolicPath CWD ('Dir Pkg))
cwd PackageDescription
pkg_descr0 [PPSuffixHandler]
pps = do
  -- Call helpers that actually do all work.
  Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDescription
-> [PPSuffixHandler]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
listPackageSources' Verbosity
verbosity Verbosity -> CabalException -> IO [res]
forall res. Verbosity -> CabalException -> IO [res]
rip Maybe (SymbolicPath CWD ('Dir Pkg))
cwd PackageDescription
pkg_descr [PPSuffixHandler]
pps
  where
    pkg_descr :: PackageDescription
pkg_descr = PackageDescription -> PackageDescription
filterAutogenModules PackageDescription
pkg_descr0

listPackageSources'
  :: Verbosity
  -- ^ verbosity
  -> (forall res. Verbosity -> CabalException -> IO [res])
  -- ^ '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.
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ directory with cabal file
  -> PackageDescription
  -- ^ info from the cabal file
  -> [PPSuffixHandler]
  -- ^ extra preprocessors (include suffixes)
  -> IO [SymbolicPath Pkg File]
listPackageSources' :: Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDescription
-> [PPSuffixHandler]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
listPackageSources' Verbosity
verbosity forall res. Verbosity -> CabalException -> IO [res]
rip Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir PackageDescription
pkg_descr [PPSuffixHandler]
pps =
  ([[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> ([IO [SymbolicPathX 'AllowAbsolute Pkg 'File]]
    -> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]])
-> [IO [SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IO [SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
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 [SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> [IO [SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$
    [ -- Library sources.
      ([[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> ((Library -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
    -> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]])
-> (Library -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
forall {f :: * -> *} {b}.
Applicative f =>
(Library -> f b) -> f [b]
withAllLib
        ((Library -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> (Library -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
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 [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
allSourcesBuildInfo Verbosity
verbosity Verbosity
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall res. Verbosity -> CabalException -> IO [res]
rip Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir BuildInfo
libBi [PPSuffixHandler]
pps ([ModuleName]
modules [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ [ModuleName]
sigs)
    , -- Executables sources.
      ([[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> ((Executable -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
    -> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]])
-> (Executable -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Executable -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
forall {f :: * -> *} {b}.
Applicative f =>
(Executable -> f b) -> f [b]
withAllExe
        ((Executable -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> (Executable -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ \Executable{modulePath :: Executable -> RelativePath Source 'File
modulePath = RelativePath Source 'File
mainPath, buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
exeBi} -> do
          biSrcs <- Verbosity
-> (Verbosity
    -> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
allSourcesBuildInfo Verbosity
verbosity Verbosity
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall res. Verbosity -> CabalException -> IO [res]
rip Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir BuildInfo
exeBi [PPSuffixHandler]
pps []
          mainSrc <- findMainExeFile verbosity mbWorkDir exeBi pps mainPath
          return (mainSrc : biSrcs)
    , -- Foreign library sources
      ([[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> ((ForeignLib -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
    -> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]])
-> (ForeignLib -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ForeignLib -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
forall {f :: * -> *} {b}.
Applicative f =>
(ForeignLib -> f b) -> f [b]
withAllFLib
        ((ForeignLib -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> (ForeignLib -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ \flib :: ForeignLib
flib@(ForeignLib{foreignLibBuildInfo :: ForeignLib -> BuildInfo
foreignLibBuildInfo = BuildInfo
flibBi}) -> do
          biSrcs <- Verbosity
-> (Verbosity
    -> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
allSourcesBuildInfo Verbosity
verbosity Verbosity
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall res. Verbosity -> CabalException -> IO [res]
rip Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir BuildInfo
flibBi [PPSuffixHandler]
pps []
          defFiles <-
            traverse
              (findModDefFile verbosity mbWorkDir flibBi pps)
              (foreignLibModDefFile flib)
          return (defFiles ++ biSrcs)
    , -- Test suites sources.
      ([[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> ((TestSuite -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
    -> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]])
-> (TestSuite -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestSuite -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
forall {f :: * -> *} {b}.
Applicative f =>
(TestSuite -> f b) -> f [b]
withAllTest
        ((TestSuite -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> (TestSuite -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
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
_ RelativePath Source 'File
mainPath -> do
              biSrcs <- Verbosity
-> (Verbosity
    -> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
allSourcesBuildInfo Verbosity
verbosity Verbosity
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall res. Verbosity -> CabalException -> IO [res]
rip Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir BuildInfo
bi [PPSuffixHandler]
pps []
              srcMainFile <- findMainExeFile verbosity mbWorkDir bi pps mainPath
              return (srcMainFile : biSrcs)
            TestSuiteLibV09 Version
_ ModuleName
m ->
              Verbosity
-> (Verbosity
    -> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
allSourcesBuildInfo Verbosity
verbosity Verbosity
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall res. Verbosity -> CabalException -> IO [res]
rip Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir BuildInfo
bi [PPSuffixHandler]
pps [ModuleName
m]
            TestSuiteUnsupported TestType
tp ->
              Verbosity
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall res. Verbosity -> CabalException -> IO [res]
rip Verbosity
verbosity (CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ [Char] -> CabalException
UnsupportedTestSuite (TestType -> [Char]
forall a. Show a => a -> [Char]
show TestType
tp)
    , -- Benchmarks sources.
      ([[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> ((Benchmark -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
    -> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]])
-> (Benchmark -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Benchmark -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
forall {f :: * -> *} {b}.
Applicative f =>
(Benchmark -> f b) -> f [b]
withAllBenchmark
        ((Benchmark -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> (Benchmark -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
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
_ RelativePath Source 'File
mainPath -> do
              biSrcs <- Verbosity
-> (Verbosity
    -> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
allSourcesBuildInfo Verbosity
verbosity Verbosity
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall res. Verbosity -> CabalException -> IO [res]
rip Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir BuildInfo
bi [PPSuffixHandler]
pps []
              srcMainFile <- findMainExeFile verbosity mbWorkDir bi pps mainPath
              return (srcMainFile : biSrcs)
            BenchmarkUnsupported BenchmarkType
tp ->
              Verbosity
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall res. Verbosity -> CabalException -> IO [res]
rip Verbosity
verbosity (CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ [Char] -> CabalException
UnsupportedBenchMark (BenchmarkType -> [Char]
forall a. Show a => a -> [Char]
show BenchmarkType
tp)
    , -- Data files.
      ([[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> ((SymbolicPathX 'OnlyRelative DataDir 'File
     -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
    -> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]])
-> (SymbolicPathX 'OnlyRelative DataDir 'File
    -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SymbolicPathX 'OnlyRelative DataDir 'File]
-> (SymbolicPathX 'OnlyRelative DataDir 'File
    -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PackageDescription -> [SymbolicPathX 'OnlyRelative DataDir 'File]
dataFiles PackageDescription
pkg_descr)
        ((SymbolicPathX 'OnlyRelative DataDir 'File
  -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> (SymbolicPathX 'OnlyRelative DataDir 'File
    -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ \SymbolicPathX 'OnlyRelative DataDir 'File
filename ->
          do
            let srcDataDirRaw :: SymbolicPathX 'AllowAbsolute Pkg ('Dir DataDir)
srcDataDirRaw = PackageDescription
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir DataDir)
dataDir PackageDescription
pkg_descr
                srcDataFile :: SymbolicPath Pkg File
                srcDataFile :: SymbolicPathX 'AllowAbsolute Pkg 'File
srcDataFile
                  | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (SymbolicPathX 'AllowAbsolute Pkg ('Dir DataDir) -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath SymbolicPathX 'AllowAbsolute Pkg ('Dir DataDir)
srcDataDirRaw) = SymbolicPathX 'AllowAbsolute Pkg ('Dir DataDir)
forall (allowAbsolute :: AllowAbsolute) from to.
SymbolicPathX allowAbsolute from ('Dir to)
sameDirectory SymbolicPathX 'AllowAbsolute Pkg ('Dir DataDir)
-> SymbolicPathX 'OnlyRelative DataDir 'File
-> SymbolicPathX 'AllowAbsolute Pkg 'File
forall p q r. PathLike p q r => p -> q -> r
</> SymbolicPathX 'OnlyRelative DataDir 'File
filename
                  | Bool
otherwise = SymbolicPathX 'AllowAbsolute Pkg ('Dir DataDir)
srcDataDirRaw SymbolicPathX 'AllowAbsolute Pkg ('Dir DataDir)
-> SymbolicPathX 'OnlyRelative DataDir 'File
-> SymbolicPathX 'AllowAbsolute Pkg 'File
forall p q r. PathLike p q r => p -> q -> r
</> SymbolicPathX 'OnlyRelative DataDir 'File
filename
            (SymbolicPathX 'AllowAbsolute Pkg 'File
 -> SymbolicPathX 'AllowAbsolute Pkg 'File)
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPathX 'AllowAbsolute Pkg 'File
-> SymbolicPathX 'AllowAbsolute Pkg 'File
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
       (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath
              ([SymbolicPathX 'AllowAbsolute Pkg 'File]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> CabalSpecVersion
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX 'AllowAbsolute Pkg 'File
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall dir (allowAbs :: AllowAbsolute) (file :: FileOrDir).
Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> CabalSpecVersion
-> Maybe (SymbolicPath CWD ('Dir dir))
-> SymbolicPathX allowAbs dir file
-> IO [SymbolicPathX allowAbs dir file]
matchDirFileGlobWithDie Verbosity
verbosity Verbosity -> CabalException -> IO [res]
forall res. Verbosity -> CabalException -> IO [res]
rip (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPathX 'AllowAbsolute Pkg 'File
srcDataFile
    , -- Extra source files.
      ([[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> ((RelativePath Pkg 'File
     -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
    -> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]])
-> (RelativePath Pkg 'File
    -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RelativePath Pkg 'File]
-> (RelativePath Pkg 'File
    -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PackageDescription -> [RelativePath Pkg 'File]
extraSrcFiles PackageDescription
pkg_descr) ((RelativePath Pkg 'File
  -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> (RelativePath Pkg 'File
    -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ \RelativePath Pkg 'File
fpath ->
        (RelativePath Pkg 'File -> SymbolicPathX 'AllowAbsolute Pkg 'File)
-> [RelativePath Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RelativePath Pkg 'File -> SymbolicPathX 'AllowAbsolute Pkg 'File
forall from (to :: FileOrDir).
RelativePath from to -> SymbolicPath from to
relativeSymbolicPath
          ([RelativePath Pkg 'File]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [RelativePath Pkg 'File]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> CabalSpecVersion
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> RelativePath Pkg 'File
-> IO [RelativePath Pkg 'File]
forall dir (allowAbs :: AllowAbsolute) (file :: FileOrDir).
Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> CabalSpecVersion
-> Maybe (SymbolicPath CWD ('Dir dir))
-> SymbolicPathX allowAbs dir file
-> IO [SymbolicPathX allowAbs dir file]
matchDirFileGlobWithDie Verbosity
verbosity Verbosity -> CabalException -> IO [res]
forall res. Verbosity -> CabalException -> IO [res]
rip (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir RelativePath Pkg 'File
fpath
    , -- Extra doc files.
      ([[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> ((RelativePath Pkg 'File
     -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
    -> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]])
-> (RelativePath Pkg 'File
    -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RelativePath Pkg 'File]
-> (RelativePath Pkg 'File
    -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PackageDescription -> [RelativePath Pkg 'File]
extraDocFiles PackageDescription
pkg_descr)
        ((RelativePath Pkg 'File
  -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> (RelativePath Pkg 'File
    -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ \RelativePath Pkg 'File
filename ->
          (RelativePath Pkg 'File -> SymbolicPathX 'AllowAbsolute Pkg 'File)
-> [RelativePath Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SymbolicPathX 'AllowAbsolute Pkg 'File
-> SymbolicPathX 'AllowAbsolute Pkg 'File
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
       (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath (SymbolicPathX 'AllowAbsolute Pkg 'File
 -> SymbolicPathX 'AllowAbsolute Pkg 'File)
-> (RelativePath Pkg 'File
    -> SymbolicPathX 'AllowAbsolute Pkg 'File)
-> RelativePath Pkg 'File
-> SymbolicPathX 'AllowAbsolute Pkg 'File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelativePath Pkg 'File -> SymbolicPathX 'AllowAbsolute Pkg 'File
forall from (to :: FileOrDir).
RelativePath from to -> SymbolicPath from to
relativeSymbolicPath)
            ([RelativePath Pkg 'File]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [RelativePath Pkg 'File]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> CabalSpecVersion
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> RelativePath Pkg 'File
-> IO [RelativePath Pkg 'File]
forall dir (allowAbs :: AllowAbsolute) (file :: FileOrDir).
Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> CabalSpecVersion
-> Maybe (SymbolicPath CWD ('Dir dir))
-> SymbolicPathX allowAbs dir file
-> IO [SymbolicPathX allowAbs dir file]
matchDirFileGlobWithDie Verbosity
verbosity Verbosity -> CabalException -> IO [res]
forall res. Verbosity -> CabalException -> IO [res]
rip (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir RelativePath Pkg 'File
filename
    , -- Extra files.
      ([[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> ((RelativePath Pkg 'File
     -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
    -> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]])
-> (RelativePath Pkg 'File
    -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RelativePath Pkg 'File]
-> (RelativePath Pkg 'File
    -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PackageDescription -> [RelativePath Pkg 'File]
extraFiles PackageDescription
pkg_descr) ((RelativePath Pkg 'File
  -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> (RelativePath Pkg 'File
    -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ \RelativePath Pkg 'File
fpath ->
        (RelativePath Pkg 'File -> SymbolicPathX 'AllowAbsolute Pkg 'File)
-> [RelativePath Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RelativePath Pkg 'File -> SymbolicPathX 'AllowAbsolute Pkg 'File
forall from (to :: FileOrDir).
RelativePath from to -> SymbolicPath from to
relativeSymbolicPath
          ([RelativePath Pkg 'File]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [RelativePath Pkg 'File]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> CabalSpecVersion
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> RelativePath Pkg 'File
-> IO [RelativePath Pkg 'File]
forall dir (allowAbs :: AllowAbsolute) (file :: FileOrDir).
Verbosity
-> (forall res. Verbosity -> CabalException -> IO [res])
-> CabalSpecVersion
-> Maybe (SymbolicPath CWD ('Dir dir))
-> SymbolicPathX allowAbs dir file
-> IO [SymbolicPathX allowAbs dir file]
matchDirFileGlobWithDie Verbosity
verbosity Verbosity -> CabalException -> IO [res]
forall res. Verbosity -> CabalException -> IO [res]
rip (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir RelativePath Pkg 'File
fpath
    , -- License file(s).
      [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((RelativePath Pkg 'File -> SymbolicPathX 'AllowAbsolute Pkg 'File)
-> [RelativePath Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> [a] -> [b]
map (RelativePath Pkg 'File -> SymbolicPathX 'AllowAbsolute Pkg 'File
forall from (to :: FileOrDir).
RelativePath from to -> SymbolicPath from to
relativeSymbolicPath (RelativePath Pkg 'File -> SymbolicPathX 'AllowAbsolute Pkg 'File)
-> (RelativePath Pkg 'File -> RelativePath Pkg 'File)
-> RelativePath Pkg 'File
-> SymbolicPathX 'AllowAbsolute Pkg 'File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelativePath Pkg 'File -> RelativePath Pkg 'File
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
       (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath) ([RelativePath Pkg 'File]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> [RelativePath Pkg 'File]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [RelativePath Pkg 'File]
licenseFiles PackageDescription
pkg_descr)
    , -- Install-include files, without autogen-include files
      ([[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        (IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> ((Library -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
    -> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]])
-> (Library -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
forall {f :: * -> *} {b}.
Applicative f =>
(Library -> f b) -> f [b]
withAllLib
        ((Library -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> (Library -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ \Library
l -> do
          let lbi :: BuildInfo
lbi = Library -> BuildInfo
libBuildInfo Library
l
              incls :: [[Char]]
incls = (RelativePath Include 'File -> [Char])
-> [RelativePath Include 'File] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RelativePath Include 'File -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath ([RelativePath Include 'File] -> [[Char]])
-> [RelativePath Include 'File] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (RelativePath Include 'File -> Bool)
-> [RelativePath Include 'File] -> [RelativePath Include 'File]
forall a. (a -> Bool) -> [a] -> [a]
filter (RelativePath Include 'File -> [RelativePath Include 'File] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` BuildInfo -> [RelativePath Include 'File]
autogenIncludes BuildInfo
lbi) (BuildInfo -> [RelativePath Include 'File]
installIncludes BuildInfo
lbi)
              relincdirs :: [[Char]]
relincdirs = (SymbolicPathX 'OnlyRelative Pkg ('Dir Include) -> [Char])
-> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPathX 'OnlyRelative Pkg ('Dir Include) -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath ([SymbolicPathX 'OnlyRelative Pkg ('Dir Include)] -> [[Char]])
-> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ SymbolicPathX 'OnlyRelative Pkg ('Dir Include)
forall (allowAbsolute :: AllowAbsolute) from to.
SymbolicPathX allowAbsolute from ('Dir to)
sameDirectory SymbolicPathX 'OnlyRelative Pkg ('Dir Include)
-> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)]
-> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)]
forall a. a -> [a] -> [a]
: (SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)
 -> Maybe (SymbolicPathX 'OnlyRelative Pkg ('Dir Include)))
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)]
-> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)
-> Maybe (SymbolicPathX 'OnlyRelative Pkg ('Dir Include))
forall from (to :: FileOrDir).
SymbolicPath from to -> Maybe (RelativePath from to)
symbolicPathRelative_maybe (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)]
includeDirs BuildInfo
lbi)
          ([Char] -> IO (SymbolicPathX 'AllowAbsolute Pkg 'File))
-> [[Char]] -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
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 ((([Char], [Char]) -> SymbolicPathX 'AllowAbsolute Pkg 'File)
-> IO ([Char], [Char])
-> IO (SymbolicPathX 'AllowAbsolute Pkg 'File)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> SymbolicPathX 'AllowAbsolute Pkg 'File
forall from (to :: FileOrDir). [Char] -> SymbolicPath from to
makeSymbolicPath ([Char] -> SymbolicPathX 'AllowAbsolute Pkg 'File)
-> (([Char], [Char]) -> [Char])
-> ([Char], [Char])
-> SymbolicPathX 'AllowAbsolute Pkg 'File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd) (IO ([Char], [Char])
 -> IO (SymbolicPathX 'AllowAbsolute Pkg 'File))
-> ([Char] -> IO ([Char], [Char]))
-> [Char]
-> IO (SymbolicPathX 'AllowAbsolute Pkg 'File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> [Char] -> [[Char]] -> [Char] -> IO ([Char], [Char])
findIncludeFile Verbosity
verbosity [Char]
cwd [[Char]]
relincdirs) [[Char]]
incls
    , -- Setup script, if it exists.
      (Maybe [Char] -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO (Maybe [Char]) -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SymbolicPathX 'AllowAbsolute Pkg 'File]
-> ([Char] -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> Maybe [Char]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\[Char]
f -> [[Char] -> SymbolicPathX 'AllowAbsolute Pkg 'File
forall from (to :: FileOrDir). [Char] -> SymbolicPath from to
makeSymbolicPath [Char]
f])) (IO (Maybe [Char]) -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO (Maybe [Char]) -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Maybe [Char])
findSetupFile [Char]
cwd
    , -- SetupHooks script, if it exists.
      (Maybe [Char] -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO (Maybe [Char]) -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SymbolicPathX 'AllowAbsolute Pkg 'File]
-> ([Char] -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> Maybe [Char]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\[Char]
f -> [[Char] -> SymbolicPathX 'AllowAbsolute Pkg 'File
forall from (to :: FileOrDir). [Char] -> SymbolicPath from to
makeSymbolicPath [Char]
f])) (IO (Maybe [Char]) -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO (Maybe [Char]) -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Maybe [Char])
findSetupHooksFile [Char]
cwd
    , -- The .cabal file itself.
      (SymbolicPathX 'AllowAbsolute Pkg 'File
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO (SymbolicPathX 'AllowAbsolute Pkg 'File)
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SymbolicPathX 'AllowAbsolute Pkg 'File
d -> [SymbolicPathX 'AllowAbsolute Pkg 'File
d]) (SymbolicPathX 'AllowAbsolute Pkg 'File
-> SymbolicPathX 'AllowAbsolute Pkg 'File
forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
       (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath (SymbolicPathX 'AllowAbsolute Pkg 'File
 -> SymbolicPathX 'AllowAbsolute Pkg 'File)
-> (RelativePath Pkg 'File
    -> SymbolicPathX 'AllowAbsolute Pkg 'File)
-> RelativePath Pkg 'File
-> SymbolicPathX 'AllowAbsolute Pkg 'File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelativePath Pkg 'File -> SymbolicPathX 'AllowAbsolute Pkg 'File
forall from (to :: FileOrDir).
RelativePath from to -> SymbolicPath from to
relativeSymbolicPath (RelativePath Pkg 'File -> SymbolicPathX 'AllowAbsolute Pkg 'File)
-> IO (RelativePath Pkg 'File)
-> IO (SymbolicPathX 'AllowAbsolute Pkg 'File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> IO (RelativePath Pkg 'File)
tryFindPackageDesc Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir)
    ]
  where
    cwd :: [Char]
cwd = [Char]
-> (SymbolicPath CWD ('Dir Pkg) -> [Char])
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"." SymbolicPath CWD ('Dir Pkg) -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
    -- 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
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ working directory
  -> PackageDescription
  -- ^ info from the cabal file
  -> FilePath
  -- ^ source tree to populate
  -> [PPSuffixHandler]
  -- ^ extra preprocessors (includes suffixes)
  -> IO ()
prepareTree :: Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDescription
-> [Char]
-> [PPSuffixHandler]
-> IO ()
prepareTree Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir PackageDescription
pkg_descr0 [Char]
targetDir [PPSuffixHandler]
pps = do
  ordinary <- Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDescription
-> [PPSuffixHandler]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
listPackageSources Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir PackageDescription
pkg_descr [PPSuffixHandler]
pps
  installOrdinaryFiles verbosity targetDir (zip (repeat []) $ map i ordinary)
  maybeCreateDefaultSetupScript targetDir
  where
    i :: SymbolicPathX allowAbsolute Pkg to -> [Char]
i = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> [Char]
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> [Char]
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
    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 :: [Char] -> IO (Maybe [Char])
findSetupFile [Char]
targetDir = do
  hsExists <- [Char] -> IO Bool
doesFileExist ([Char]
targetDir [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
setupHs)
  lhsExists <- doesFileExist (targetDir </> setupLhs)
  if hsExists
    then return (Just setupHs)
    else
      if lhsExists
        then return (Just setupLhs)
        else return Nothing
  where
    setupHs :: [Char]
setupHs = [Char]
"Setup.hs"
    setupLhs :: [Char]
setupLhs = [Char]
"Setup.lhs"

-- | Find the setup hooks script file, if it exists.
findSetupHooksFile :: FilePath -> IO (Maybe FilePath)
findSetupHooksFile :: [Char] -> IO (Maybe [Char])
findSetupHooksFile [Char]
targetDir = do
  hsExists <- [Char] -> IO Bool
doesFileExist ([Char]
targetDir [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
setupHs)
  lhsExists <- doesFileExist (targetDir </> setupLhs)
  if hsExists
    then return (Just setupHs)
    else
      if lhsExists
        then return (Just setupLhs)
        else return Nothing
  where
    setupHs :: [Char]
setupHs = [Char]
"SetupHooks.hs"
    setupLhs :: [Char]
setupLhs = [Char]
"SetupHooks.lhs"

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

-- | Find the main executable file.
findMainExeFile
  :: Verbosity
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ working directory
  -> BuildInfo
  -> [PPSuffixHandler]
  -> RelativePath Source File
  -- ^ main-is
  -> IO (SymbolicPath Pkg File)
findMainExeFile :: Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> BuildInfo
-> [PPSuffixHandler]
-> RelativePath Source 'File
-> IO (SymbolicPathX 'AllowAbsolute Pkg 'File)
findMainExeFile Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
cwd BuildInfo
exeBi [PPSuffixHandler]
pps RelativePath Source 'File
mainPath = do
  ppFile <-
    Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Suffix]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> RelativePath Source 'File
-> IO (Maybe (SymbolicPathX 'AllowAbsolute Pkg 'File))
forall searchDir (allowAbsolute :: AllowAbsolute).
Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Suffix]
-> [SymbolicPathX allowAbsolute Pkg ('Dir searchDir)]
-> RelativePath searchDir 'File
-> IO (Maybe (SymbolicPathX allowAbsolute Pkg 'File))
findFileCwdWithExtension
      Maybe (SymbolicPath CWD ('Dir Pkg))
cwd
      ([PPSuffixHandler] -> [Suffix]
ppSuffixes [PPSuffixHandler]
pps)
      (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
hsSourceDirs BuildInfo
exeBi)
      (RelativePath Source 'File -> RelativePath Source 'File
forall (allowAbsolute :: AllowAbsolute) from.
SymbolicPathX allowAbsolute from 'File
-> SymbolicPathX allowAbsolute from 'File
dropExtensionsSymbolicPath RelativePath Source 'File
mainPath)
  case ppFile of
    Maybe (SymbolicPathX 'AllowAbsolute Pkg 'File)
Nothing -> Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> RelativePath Source 'File
-> IO (SymbolicPathX 'AllowAbsolute Pkg 'File)
forall searchDir (allowAbsolute :: AllowAbsolute).
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX allowAbsolute Pkg ('Dir searchDir)]
-> RelativePath searchDir 'File
-> IO (SymbolicPathX allowAbsolute Pkg 'File)
findFileCwd Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
cwd (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
hsSourceDirs BuildInfo
exeBi) RelativePath Source 'File
mainPath
    Just SymbolicPathX 'AllowAbsolute Pkg 'File
pp -> SymbolicPathX 'AllowAbsolute Pkg 'File
-> IO (SymbolicPathX 'AllowAbsolute Pkg 'File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SymbolicPathX 'AllowAbsolute Pkg 'File
pp

-- | Find a module definition file
--
-- TODO: I don't know if this is right
findModDefFile
  :: Verbosity
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -> BuildInfo
  -> [PPSuffixHandler]
  -> RelativePath Source File
  -> IO (SymbolicPath Pkg File)
findModDefFile :: Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> BuildInfo
-> [PPSuffixHandler]
-> RelativePath Source 'File
-> IO (SymbolicPathX 'AllowAbsolute Pkg 'File)
findModDefFile Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
cwd BuildInfo
flibBi [PPSuffixHandler]
_pps RelativePath Source 'File
modDefPath =
  Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> RelativePath Source 'File
-> IO (SymbolicPathX 'AllowAbsolute Pkg 'File)
forall searchDir (allowAbsolute :: AllowAbsolute).
Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> [SymbolicPathX allowAbsolute Pkg ('Dir searchDir)]
-> RelativePath searchDir 'File
-> IO (SymbolicPathX allowAbsolute Pkg 'File)
findFileCwd Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
cwd (SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
forall (allowAbsolute :: AllowAbsolute) from to.
SymbolicPathX allowAbsolute from ('Dir to)
sameDirectory SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
forall a. a -> [a] -> [a]
: BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
hsSourceDirs BuildInfo
flibBi) RelativePath Source 'File
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 -> [Char] -> [[Char]] -> [Char] -> IO ([Char], [Char])
findIncludeFile Verbosity
verbosity [Char]
_ [] [Char]
f = Verbosity -> CabalException -> IO ([Char], [Char])
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ([Char], [Char]))
-> CabalException -> IO ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> CabalException
NoIncludeFileFound [Char]
f
findIncludeFile Verbosity
verbosity [Char]
cwd ([Char]
d : [[Char]]
ds) [Char]
f = do
  let path :: [Char]
path = [Char]
d [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
f
  b <- [Char] -> IO Bool
doesFileExist ([Char]
cwd [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> [Char]
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
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ working directory
  -> PackageDescription
  -- ^ info from the cabal file
  -> FilePath
  -- ^ source tree to populate
  -> [PPSuffixHandler]
  -- ^ extra preprocessors (includes suffixes)
  -> IO ()
prepareSnapshotTree :: Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDescription
-> [Char]
-> [PPSuffixHandler]
-> IO ()
prepareSnapshotTree Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir PackageDescription
pkg [Char]
targetDir [PPSuffixHandler]
pps = do
  Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDescription
-> [Char]
-> [PPSuffixHandler]
-> IO ()
prepareTree Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir PackageDescription
pkg [Char]
targetDir [PPSuffixHandler]
pps
  Verbosity -> PackageDescription -> [Char] -> IO ()
overwriteSnapshotPackageDesc Verbosity
verbosity PackageDescription
pkg [Char]
targetDir

overwriteSnapshotPackageDesc
  :: Verbosity
  -- ^ verbosity
  -> PackageDescription
  -- ^ info from the cabal file
  -> FilePath
  -- ^ source tree
  -> IO ()
overwriteSnapshotPackageDesc :: Verbosity -> PackageDescription -> [Char] -> IO ()
overwriteSnapshotPackageDesc Verbosity
verbosity PackageDescription
pkg [Char]
targetDir = do
  -- We could just writePackageDescription targetDescFile pkg_descr,
  -- but that would lose comments and formatting.
  descFile <- RelativePath Pkg 'File -> [Char]
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> [Char]
getSymbolicPath (RelativePath Pkg 'File -> [Char])
-> IO (RelativePath Pkg 'File) -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity -> IO (RelativePath Pkg 'File)
defaultPackageDescCwd Verbosity
verbosity
  withUTF8FileContents descFile $
    writeUTF8File (targetDir </> descFile)
      . unlines
      . map (replaceVersion (packageVersion pkg))
      . lines
  where
    replaceVersion :: Version -> String -> String
    replaceVersion :: Version -> [Char] -> [Char]
replaceVersion Version
version [Char]
line
      | [Char]
"version:" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
line =
          [Char]
"version: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow Version
version
      | Bool
otherwise = [Char]
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 -> (Integer, Int, Int)
toGregorian (UTCTime -> Day
utctDay UTCTime
date) of
  (Integer
year, Int
month, Int
day) ->
    Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
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 -> [Char] -> [Char] -> IO [Char]
createArchive Verbosity
verbosity PackageDescription
pkg_descr [Char]
tmpDir [Char]
targetPref = do
  let tarBallFilePath :: [Char]
tarBallFilePath = [Char]
targetPref [Char] -> [Char] -> [Char]
forall p q r. PathLike p q r => p -> q -> r
</> PackageDescription -> [Char]
tarBallName PackageDescription
pkg_descr [Char] -> [Char] -> [Char]
forall p. FileLike p => p -> [Char] -> p
<.> [Char]
"tar.gz"
  (tarProg, _) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
tarProgram ProgramDb
defaultProgramDb
  let formatOptSupported =
        Bool -> ([Char] -> Bool) -> Maybe [Char] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"YES") (Maybe [Char] -> Bool) -> Maybe [Char] -> Bool
forall a b. (a -> b) -> a -> b
$
          [Char] -> Map [Char] [Char] -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup
            [Char]
"Supports --format"
            (ConfiguredProgram -> Map [Char] [Char]
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 [SymbolicPath Pkg File])
  -- ^ '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.
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ working directory
  -> BuildInfo
  -> [PPSuffixHandler]
  -- ^ Extra preprocessors
  -> [ModuleName]
  -- ^ Exposed modules
  -> IO [SymbolicPath Pkg File]
allSourcesBuildInfo :: Verbosity
-> (Verbosity
    -> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
allSourcesBuildInfo Verbosity
verbosity Verbosity
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
rip Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir BuildInfo
bi [PPSuffixHandler]
pps [ModuleName]
modules = do
  let searchDirs :: [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
searchDirs = BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bi
  sources <-
    ([[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. (a -> b) -> a -> b
$
      [IO [SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
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 [SymbolicPathX 'AllowAbsolute Pkg 'File]]
 -> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]])
-> [IO [SymbolicPathX 'AllowAbsolute Pkg 'File]]
-> IO [[SymbolicPathX 'AllowAbsolute Pkg 'File]]
forall a b. (a -> b) -> a -> b
$
        [ let file :: SymbolicPathX allowAbsolute Source 'File
file = ModuleName -> SymbolicPathX allowAbsolute Source 'File
forall (allowAbsolute :: AllowAbsolute).
ModuleName -> SymbolicPathX allowAbsolute Source 'File
moduleNameSymbolicPath 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.
              Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Suffix]
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
-> RelativePath Source 'File
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall searchDir (allowAbsolute :: AllowAbsolute).
Maybe (SymbolicPath CWD ('Dir Pkg))
-> [Suffix]
-> [SymbolicPathX allowAbsolute Pkg ('Dir searchDir)]
-> RelativePath searchDir 'File
-> IO [SymbolicPathX allowAbsolute Pkg 'File]
findAllFilesCwdWithExtension Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir [Suffix]
suffixes [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
searchDirs RelativePath Source 'File
forall {allowAbsolute :: AllowAbsolute}.
SymbolicPathX allowAbsolute Source 'File
file
                IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> ([SymbolicPathX 'AllowAbsolute Pkg 'File]
    -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> ([SymbolicPathX 'AllowAbsolute Pkg 'File]
    -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
forall b a. b -> ([a] -> b) -> [a] -> b
nonEmpty' (ModuleName -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
notFound ModuleName
module_) [SymbolicPathX 'AllowAbsolute Pkg 'File]
-> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
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 -> SymbolicPathX allowAbsolute Source 'File
forall (allowAbsolute :: AllowAbsolute).
ModuleName -> SymbolicPathX allowAbsolute Source 'File
moduleNameSymbolicPath ModuleName
module_
            fileExts = [Suffix]
builtinHaskellBootSuffixes
         in findFileCwdWithExtension mbWorkDir fileExts (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 [SymbolicPath Pkg File]
    notFound :: ModuleName -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
notFound ModuleName
m =
      Verbosity
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
rip Verbosity
verbosity (CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File])
-> CabalException -> IO [SymbolicPathX 'AllowAbsolute Pkg 'File]
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 -> [Char] -> IO [PackageCheck]
checkPackageFiles Verbosity
verbosity PackageDescription
pkg_descr [Char]
"."
  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 -> [Char]
tarBallName = PackageIdentifier -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (PackageIdentifier -> [Char])
-> (PackageDescription -> PackageIdentifier)
-> PackageDescription
-> [Char]
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)}