{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.SrcDist (
sdist,
printPackageProblems,
prepareTree,
createArchive,
prepareSnapshotTree,
snapshotPackage,
snapshotVersion,
dateToSnapshotNumber,
listPackageSources
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.PackageDescription hiding (Flag)
import Distribution.PackageDescription.Check hiding (doesFileExist)
import Distribution.Package
import Distribution.ModuleName
import qualified Distribution.ModuleName as ModuleName
import Distribution.Version
import Distribution.Simple.Configure (findDistPrefOrDefault)
import Distribution.Simple.Glob
import Distribution.Simple.Utils
import Distribution.Simple.Setup
import Distribution.Simple.PreProcess
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.BuildPaths
import Distribution.Simple.Program
import Distribution.Pretty
import Distribution.Types.ForeignLib
import Distribution.Verbosity
import Data.List (partition)
import qualified Data.Map as Map
import Data.Time (UTCTime, getCurrentTime, toGregorian, utctDay)
import System.Directory ( doesFileExist )
import System.IO (IOMode(WriteMode), hPutStrLn, withFile)
import System.FilePath ((</>), (<.>), dropExtension, isRelative)
import Control.Monad
sdist :: PackageDescription
-> Maybe LocalBuildInfo
-> SDistFlags
-> (FilePath -> FilePath)
-> [PPSuffixHandler]
-> IO ()
sdist :: PackageDescription
-> Maybe LocalBuildInfo
-> SDistFlags
-> (FilePath -> FilePath)
-> [PPSuffixHandler]
-> IO ()
sdist PackageDescription
pkg Maybe LocalBuildInfo
mb_lbi SDistFlags
flags FilePath -> FilePath
mkTmpDir [PPSuffixHandler]
pps = do
FilePath
distPref <- Flag FilePath -> NoCallStackIO FilePath
findDistPrefOrDefault (Flag FilePath -> NoCallStackIO FilePath)
-> Flag FilePath -> NoCallStackIO FilePath
forall a b. (a -> b) -> a -> b
$ SDistFlags -> Flag FilePath
sDistDistPref SDistFlags
flags
let targetPref :: FilePath
targetPref = FilePath
distPref
tmpTargetDir :: FilePath
tmpTargetDir = FilePath -> FilePath
mkTmpDir FilePath
distPref
case (SDistFlags -> Flag FilePath
sDistListSources SDistFlags
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
([FilePath]
ordinary, [FilePath]
maybeExecutable) <- Verbosity
-> PackageDescription
-> [PPSuffixHandler]
-> IO ([FilePath], [FilePath])
listPackageSources Verbosity
verbosity PackageDescription
pkg [PPSuffixHandler]
pps
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
External instance of the constraint type Applicative IO
External instance of the constraint type Foldable []
traverse_ (Handle -> FilePath -> IO ()
hPutStrLn Handle
outHandle) [FilePath]
ordinary
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
External instance of the constraint type Applicative IO
External instance of the constraint type Foldable []
traverse_ (Handle -> FilePath -> IO ()
hPutStrLn Handle
outHandle) [FilePath]
maybeExecutable
Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"List of package sources written to file '"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'"
Flag FilePath
NoFlag -> do
Verbosity -> PackageDescription -> IO ()
printPackageProblems Verbosity
verbosity PackageDescription
pkg
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
External instance of the constraint type Applicative IO
when (Maybe LocalBuildInfo -> Bool
forall a. Maybe a -> Bool
isNothing Maybe LocalBuildInfo
mb_lbi) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity FilePath
"Cannot run preprocessors. Run 'configure' command first."
UTCTime
date <- IO UTCTime
getCurrentTime
let pkg' :: PackageDescription
pkg' | Bool
snapshot = UTCTime -> PackageDescription -> PackageDescription
snapshotPackage UTCTime
date PackageDescription
pkg
| Bool
otherwise = PackageDescription
pkg
case Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe (SDistFlags -> Flag FilePath
sDistDirectory SDistFlags
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'
FilePath
targzFile <- CreateArchiveFun
createArchive Verbosity
verbosity PackageDescription
pkg' Maybe LocalBuildInfo
mb_lbi FilePath
tmpDir FilePath
targetPref
Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Source tarball created: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
targzFile
where
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
External instance of the constraint type Package PackageDescription
packageId PackageDescription
pkg')
Verbosity
-> PackageDescription
-> Maybe LocalBuildInfo
-> FilePath
-> [PPSuffixHandler]
-> IO ()
prepareTree Verbosity
verbosity PackageDescription
pkg' Maybe LocalBuildInfo
mb_lbi FilePath
targetDir [PPSuffixHandler]
pps
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
External instance of the constraint type Applicative IO
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)
Evidence bound by a HsWrapper of the constraint type HasCallStack
fromFlag (SDistFlags -> Flag Verbosity
sDistVerbosity SDistFlags
flags)
snapshot :: Bool
snapshot = Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
Evidence bound by a HsWrapper of the constraint type HasCallStack
fromFlag (SDistFlags -> Flag Bool
sDistSnapshot SDistFlags
flags)
listPackageSources :: Verbosity
-> PackageDescription
-> [PPSuffixHandler]
-> IO ([FilePath], [FilePath])
listPackageSources :: Verbosity
-> PackageDescription
-> [PPSuffixHandler]
-> IO ([FilePath], [FilePath])
listPackageSources Verbosity
verbosity PackageDescription
pkg_descr0 [PPSuffixHandler]
pps = do
[FilePath]
ordinary <- Verbosity
-> PackageDescription -> [PPSuffixHandler] -> IO [FilePath]
listPackageSourcesOrdinary Verbosity
verbosity PackageDescription
pkg_descr [PPSuffixHandler]
pps
[FilePath]
maybeExecutable <- Verbosity -> PackageDescription -> IO [FilePath]
listPackageSourcesMaybeExecutable Verbosity
verbosity PackageDescription
pkg_descr
([FilePath], [FilePath]) -> IO ([FilePath], [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ([FilePath]
ordinary, [FilePath]
maybeExecutable)
where
pkg_descr :: PackageDescription
pkg_descr = PackageDescription -> PackageDescription
filterAutogenModules PackageDescription
pkg_descr0
listPackageSourcesMaybeExecutable :: Verbosity -> PackageDescription -> IO [FilePath]
listPackageSourcesMaybeExecutable :: Verbosity -> PackageDescription -> IO [FilePath]
listPackageSourcesMaybeExecutable Verbosity
verbosity PackageDescription
pkg_descr =
([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
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)
External instance of the constraint type Applicative IO
External instance of the constraint type Traversable []
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 -> Version -> FilePath -> FilePath -> IO [FilePath]
matchDirFileGlob Verbosity
verbosity (PackageDescription -> Version
specVersion PackageDescription
pkg_descr) FilePath
"." FilePath
fpath
listPackageSourcesOrdinary :: Verbosity
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSourcesOrdinary :: Verbosity
-> PackageDescription -> [PPSuffixHandler] -> IO [FilePath]
listPackageSourcesOrdinary Verbosity
verbosity PackageDescription
pkg_descr [PPSuffixHandler]
pps =
([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
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)
External instance of the constraint type Applicative IO
External instance of the constraint type Traversable []
sequenceA ([IO [FilePath]] -> IO [FilePath])
-> [IO [FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
[
([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
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]
External instance of the constraint type Applicative IO
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
-> BuildInfo -> [PPSuffixHandler] -> [ModuleName] -> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity BuildInfo
libBi [PPSuffixHandler]
pps ([ModuleName]
modules [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ [ModuleName]
sigs)
, ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
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]
External instance of the constraint type Applicative IO
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
[FilePath]
biSrcs <- Verbosity
-> BuildInfo -> [PPSuffixHandler] -> [ModuleName] -> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity BuildInfo
exeBi [PPSuffixHandler]
pps []
FilePath
mainSrc <- Verbosity
-> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath
findMainExeFile Verbosity
verbosity BuildInfo
exeBi [PPSuffixHandler]
pps FilePath
mainPath
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (FilePath
mainSrcFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
biSrcs)
, ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
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]
External instance of the constraint type Applicative IO
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
[FilePath]
biSrcs <- Verbosity
-> BuildInfo -> [PPSuffixHandler] -> [ModuleName] -> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity BuildInfo
flibBi [PPSuffixHandler]
pps []
[FilePath]
defFiles <- (FilePath -> NoCallStackIO FilePath) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
External instance of the constraint type Monad IO
External instance of the constraint type Traversable []
mapM (Verbosity
-> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath
findModDefFile Verbosity
verbosity BuildInfo
flibBi [PPSuffixHandler]
pps)
(ForeignLib -> [FilePath]
foreignLibModDefFile ForeignLib
flib)
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ([FilePath]
defFiles [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
biSrcs)
, ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
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]
External instance of the constraint type Applicative IO
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
[FilePath]
biSrcs <- Verbosity
-> BuildInfo -> [PPSuffixHandler] -> [ModuleName] -> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity BuildInfo
bi [PPSuffixHandler]
pps []
FilePath
srcMainFile <- Verbosity
-> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath
findMainExeFile Verbosity
verbosity BuildInfo
bi [PPSuffixHandler]
pps FilePath
mainPath
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (FilePath
srcMainFileFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
biSrcs)
TestSuiteLibV09 Version
_ ModuleName
m ->
Verbosity
-> BuildInfo -> [PPSuffixHandler] -> [ModuleName] -> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity BuildInfo
bi [PPSuffixHandler]
pps [ModuleName
m]
TestSuiteUnsupported TestType
tp ->
Verbosity -> FilePath -> IO [FilePath]
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
"Unsupported test suite type: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ TestType -> FilePath
forall a. Show a => a -> FilePath
External instance of the constraint type Show TestType
show TestType
tp
, ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
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]
External instance of the constraint type Applicative IO
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
[FilePath]
biSrcs <- Verbosity
-> BuildInfo -> [PPSuffixHandler] -> [ModuleName] -> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity BuildInfo
bi [PPSuffixHandler]
pps []
FilePath
srcMainFile <- Verbosity
-> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath
findMainExeFile Verbosity
verbosity BuildInfo
bi [PPSuffixHandler]
pps FilePath
mainPath
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (FilePath
srcMainFileFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
biSrcs)
BenchmarkUnsupported BenchmarkType
tp -> Verbosity -> FilePath -> IO [FilePath]
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
"Unsupported benchmark type: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ BenchmarkType -> FilePath
forall a. Show a => a -> FilePath
External instance of the constraint type Show BenchmarkType
show BenchmarkType
tp
, ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
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)
External instance of the constraint type Applicative IO
External instance of the constraint type Traversable []
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 ->
let srcDataDirRaw :: FilePath
srcDataDirRaw = PackageDescription -> FilePath
dataDir PackageDescription
pkg_descr
srcDataDir :: FilePath
srcDataDir = if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null FilePath
srcDataDirRaw
then FilePath
"."
else FilePath
srcDataDirRaw
in ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor []
fmap (FilePath
srcDataDir FilePath -> FilePath -> FilePath
</>)) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
Verbosity -> Version -> FilePath -> FilePath -> IO [FilePath]
matchDirFileGlob Verbosity
verbosity (PackageDescription -> Version
specVersion PackageDescription
pkg_descr) FilePath
srcDataDir FilePath
filename
, ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
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)
External instance of the constraint type Applicative IO
External instance of the constraint type Traversable []
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 -> Version -> FilePath -> FilePath -> IO [FilePath]
matchDirFileGlob Verbosity
verbosity (PackageDescription -> Version
specVersion PackageDescription
pkg_descr) FilePath
"." FilePath
filename
, [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (PackageDescription -> [FilePath]
licenseFiles PackageDescription
pkg_descr)
, ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
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]
External instance of the constraint type Applicative IO
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
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`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 -> NoCallStackIO FilePath) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
External instance of the constraint type Applicative IO
External instance of the constraint type Traversable []
traverse (((FilePath, FilePath) -> FilePath)
-> IO (FilePath, FilePath) -> NoCallStackIO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd (IO (FilePath, FilePath) -> NoCallStackIO FilePath)
-> (FilePath -> IO (FilePath, FilePath))
-> FilePath
-> NoCallStackIO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> [FilePath] -> FilePath -> IO (FilePath, FilePath)
findIncludeFile Verbosity
verbosity [FilePath]
relincdirs) [FilePath]
incls
, (Maybe FilePath -> [FilePath])
-> IO (Maybe FilePath) -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
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
""
, (FilePath -> [FilePath]) -> NoCallStackIO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap (\FilePath
d -> [FilePath
d]) (Verbosity -> IO FilePath
defaultPackageDesc Verbosity
verbosity)
]
where
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)
Evidence bound by a type signature of the constraint type Applicative f
External instance of the constraint type Traversable []
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)
Evidence bound by a type signature of the constraint type Applicative f
External instance of the constraint type Traversable []
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)
Evidence bound by a type signature of the constraint type Applicative f
External instance of the constraint type Traversable []
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)
Evidence bound by a type signature of the constraint type Applicative f
External instance of the constraint type Traversable []
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)
Evidence bound by a type signature of the constraint type Applicative f
External instance of the constraint type Traversable []
traverse Benchmark -> f b
action (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg_descr)
prepareTree :: Verbosity
-> PackageDescription
-> Maybe LocalBuildInfo
-> FilePath
-> [PPSuffixHandler]
-> IO ()
prepareTree :: Verbosity
-> PackageDescription
-> Maybe LocalBuildInfo
-> FilePath
-> [PPSuffixHandler]
-> IO ()
prepareTree Verbosity
verbosity PackageDescription
pkg_descr0 Maybe LocalBuildInfo
mb_lbi FilePath
targetDir [PPSuffixHandler]
pps = do
case Maybe LocalBuildInfo
mb_lbi of
Just LocalBuildInfo
lbi | Bool -> Bool
not ([PPSuffixHandler] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [PPSuffixHandler]
pps) -> do
let lbi' :: LocalBuildInfo
lbi' = LocalBuildInfo
lbi{ buildDir :: FilePath
buildDir = FilePath
targetDir FilePath -> FilePath -> FilePath
</> LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi }
PackageDescription
-> LocalBuildInfo
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withAllComponentsInBuildOrder PackageDescription
pkg_descr LocalBuildInfo
lbi' ((Component -> ComponentLocalBuildInfo -> IO ()) -> IO ())
-> (Component -> ComponentLocalBuildInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Component
c ComponentLocalBuildInfo
clbi ->
PackageDescription
-> Component
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> Bool
-> Verbosity
-> [PPSuffixHandler]
-> IO ()
preprocessComponent PackageDescription
pkg_descr Component
c LocalBuildInfo
lbi' ComponentLocalBuildInfo
clbi Bool
True Verbosity
verbosity [PPSuffixHandler]
pps
Maybe LocalBuildInfo
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ()
([FilePath]
ordinary, [FilePath]
mExecutable) <- Verbosity
-> PackageDescription
-> [PPSuffixHandler]
-> IO ([FilePath], [FilePath])
listPackageSources Verbosity
verbosity PackageDescription
pkg_descr0 [PPSuffixHandler]
pps
Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
installOrdinaryFiles Verbosity
verbosity FilePath
targetDir ([FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip (FilePath -> [FilePath]
forall a. a -> [a]
repeat []) [FilePath]
ordinary)
Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()
installMaybeExecutableFiles Verbosity
verbosity FilePath
targetDir ([FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip (FilePath -> [FilePath]
forall a. a -> [a]
repeat []) [FilePath]
mExecutable)
FilePath -> IO ()
maybeCreateDefaultSetupScript FilePath
targetDir
where
pkg_descr :: PackageDescription
pkg_descr = PackageDescription -> PackageDescription
filterAutogenModules PackageDescription
pkg_descr0
findSetupFile :: FilePath -> NoCallStackIO (Maybe FilePath)
findSetupFile :: FilePath -> IO (Maybe FilePath)
findSetupFile FilePath
targetDir = do
Bool
hsExists <- FilePath -> IO Bool
doesFileExist FilePath
setupHs
Bool
lhsExists <- FilePath -> IO Bool
doesFileExist FilePath
setupLhs
if Bool
hsExists
then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
setupHs)
else if Bool
lhsExists
then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
setupLhs)
else Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Maybe FilePath
forall a. Maybe a
Nothing
where
setupHs :: FilePath
setupHs = FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
"Setup.hs"
setupLhs :: FilePath
setupLhs = FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
"Setup.lhs"
maybeCreateDefaultSetupScript :: FilePath -> NoCallStackIO ()
maybeCreateDefaultSetupScript :: FilePath -> IO ()
maybeCreateDefaultSetupScript FilePath
targetDir = do
Maybe FilePath
mSetupFile <- FilePath -> IO (Maybe FilePath)
findSetupFile FilePath
targetDir
case Maybe FilePath
mSetupFile of
Just FilePath
_setupFile -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
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"]
findMainExeFile
:: Verbosity -> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath
findMainExeFile :: Verbosity
-> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath
findMainExeFile Verbosity
verbosity BuildInfo
exeBi [PPSuffixHandler]
pps FilePath
mainPath = do
Maybe FilePath
ppFile <- [FilePath] -> [FilePath] -> FilePath -> IO (Maybe FilePath)
findFileWithExtension ([PPSuffixHandler] -> [FilePath]
ppSuffixes [PPSuffixHandler]
pps) (BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
exeBi)
(FilePath -> FilePath
dropExtension FilePath
mainPath)
case Maybe FilePath
ppFile of
Maybe FilePath
Nothing -> Verbosity -> [FilePath] -> FilePath -> IO FilePath
findFileEx Verbosity
verbosity (BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
exeBi) FilePath
mainPath
Just FilePath
pp -> FilePath -> NoCallStackIO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return FilePath
pp
findModDefFile
:: Verbosity -> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath
findModDefFile :: Verbosity
-> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath
findModDefFile Verbosity
verbosity BuildInfo
flibBi [PPSuffixHandler]
_pps FilePath
modDefPath =
Verbosity -> [FilePath] -> FilePath -> IO FilePath
findFileEx Verbosity
verbosity (FilePath
"."FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
flibBi) FilePath
modDefPath
findIncludeFile :: Verbosity -> [FilePath] -> String -> IO (String, FilePath)
findIncludeFile :: Verbosity -> [FilePath] -> FilePath -> IO (FilePath, FilePath)
findIncludeFile Verbosity
verbosity [] FilePath
f = Verbosity -> FilePath -> IO (FilePath, FilePath)
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath
"can't find include file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f)
findIncludeFile Verbosity
verbosity (FilePath
d:[FilePath]
ds) FilePath
f = do
let path :: FilePath
path = (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
f)
Bool
b <- FilePath -> IO Bool
doesFileExist FilePath
path
if Bool
b then (FilePath, FilePath) -> IO (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (FilePath
f,FilePath
path) else Verbosity -> [FilePath] -> FilePath -> IO (FilePath, FilePath)
findIncludeFile Verbosity
verbosity [FilePath]
ds FilePath
f
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 :: Maybe Library
library = (Library -> Library) -> Maybe Library -> Maybe Library
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor Maybe
fmap Library -> Library
f (PackageDescription -> Maybe Library
library PackageDescription
pkg)
, subLibraries :: [Library]
subLibraries = (Library -> Library) -> [Library] -> [Library]
forall a b. (a -> b) -> [a] -> [b]
map Library -> Library
f (PackageDescription -> [Library]
subLibraries PackageDescription
pkg) }
filterAutogenModuleLib :: Library -> Library
filterAutogenModuleLib Library
lib = Library
lib {
exposedModules :: [ModuleName]
exposedModules = (ModuleName -> Bool) -> [ModuleName] -> [ModuleName]
forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> ModuleName -> Bool
filterFunction (Library -> BuildInfo
libBuildInfo Library
lib)) (Library -> [ModuleName]
exposedModules Library
lib)
}
filterAutogenModuleBI :: BuildInfo -> BuildInfo
filterAutogenModuleBI BuildInfo
bi = BuildInfo
bi {
otherModules :: [ModuleName]
otherModules = (ModuleName -> Bool) -> [ModuleName] -> [ModuleName]
forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> ModuleName -> Bool
filterFunction BuildInfo
bi) (BuildInfo -> [ModuleName]
otherModules BuildInfo
bi)
}
pathsModule :: ModuleName
pathsModule = PackageDescription -> ModuleName
autogenPathsModuleName PackageDescription
pkg_descr0
filterFunction :: BuildInfo -> ModuleName -> Bool
filterFunction BuildInfo
bi = \ModuleName
mn ->
ModuleName
mn ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq ModuleName
/= ModuleName
pathsModule
Bool -> Bool -> Bool
&& Bool -> Bool
not (ModuleName
mn ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq ModuleName
External instance of the constraint type Foldable []
`elem` BuildInfo -> [ModuleName]
autogenModules BuildInfo
bi)
prepareSnapshotTree :: Verbosity
-> PackageDescription
-> Maybe LocalBuildInfo
-> FilePath
-> [PPSuffixHandler]
-> IO ()
prepareSnapshotTree :: Verbosity
-> PackageDescription
-> Maybe LocalBuildInfo
-> FilePath
-> [PPSuffixHandler]
-> IO ()
prepareSnapshotTree Verbosity
verbosity PackageDescription
pkg Maybe LocalBuildInfo
mb_lbi FilePath
targetDir [PPSuffixHandler]
pps = do
Verbosity
-> PackageDescription
-> Maybe LocalBuildInfo
-> FilePath
-> [PPSuffixHandler]
-> IO ()
prepareTree Verbosity
verbosity PackageDescription
pkg Maybe LocalBuildInfo
mb_lbi FilePath
targetDir [PPSuffixHandler]
pps
Verbosity -> PackageDescription -> FilePath -> IO ()
overwriteSnapshotPackageDesc Verbosity
verbosity PackageDescription
pkg FilePath
targetDir
overwriteSnapshotPackageDesc :: Verbosity
-> PackageDescription
-> FilePath
-> IO ()
overwriteSnapshotPackageDesc :: Verbosity -> PackageDescription -> FilePath -> IO ()
overwriteSnapshotPackageDesc Verbosity
verbosity PackageDescription
pkg FilePath
targetDir = do
FilePath
descFile <- Verbosity -> IO FilePath
defaultPackageDesc Verbosity
verbosity
FilePath -> (FilePath -> IO ()) -> IO ()
forall a. FilePath -> (FilePath -> IO a) -> IO a
withUTF8FileContents FilePath
descFile ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath -> FilePath -> IO ()
writeUTF8File (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
descFile)
(FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Version -> FilePath -> FilePath
replaceVersion (PackageDescription -> Version
forall pkg. Package pkg => pkg -> Version
External instance of the constraint type Package PackageDescription
packageVersion PackageDescription
pkg)) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
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
External instance of the constraint type Eq Char
`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
External instance of the constraint type Pretty Version
prettyShow Version
version
| Bool
otherwise = FilePath
line
snapshotPackage :: UTCTime -> PackageDescription -> PackageDescription
snapshotPackage :: UTCTime -> PackageDescription -> PackageDescription
snapshotPackage UTCTime
date PackageDescription
pkg =
PackageDescription
pkg {
package :: PackageIdentifier
package = PackageIdentifier
pkgid { pkgVersion :: Version
pkgVersion = UTCTime -> Version -> Version
snapshotVersion UTCTime
date (PackageIdentifier -> Version
pkgVersion PackageIdentifier
pkgid) }
}
where pkgid :: PackageIdentifier
pkgid = PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
External instance of the constraint type Package PackageDescription
packageId PackageDescription
pkg
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])
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
External instance of the constraint type Num Int
External instance of the constraint type Integral Integer
fromIntegral Integer
year Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
10000
Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
month Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
100
Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
day
type CreateArchiveFun = Verbosity
-> PackageDescription
-> Maybe LocalBuildInfo
-> FilePath
-> FilePath
-> IO FilePath
createArchive :: CreateArchiveFun
createArchive :: CreateArchiveFun
createArchive Verbosity
verbosity PackageDescription
pkg_descr Maybe LocalBuildInfo
mb_lbi 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"
(ConfiguredProgram
tarProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
tarProgram
(ProgramDb
-> (LocalBuildInfo -> ProgramDb)
-> Maybe LocalBuildInfo
-> ProgramDb
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ProgramDb
defaultProgramDb LocalBuildInfo -> ProgramDb
withPrograms Maybe LocalBuildInfo
mb_lbi)
let formatOptSupported :: Bool
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
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
== 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
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Map.lookup FilePath
"Supports --format"
(ConfiguredProgram -> Map FilePath FilePath
programProperties ConfiguredProgram
tarProg)
Verbosity -> ConfiguredProgram -> [FilePath] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
tarProg ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$
[FilePath
"-czf", FilePath
tarBallFilePath, FilePath
"-C", FilePath
tmpDir]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Bool
formatOptSupported then [FilePath
"--format", FilePath
"ustar"] else [])
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [PackageDescription -> FilePath
tarBallName PackageDescription
pkg_descr]
FilePath -> NoCallStackIO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return FilePath
tarBallFilePath
allSourcesBuildInfo :: Verbosity
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo :: Verbosity
-> BuildInfo -> [PPSuffixHandler] -> [ModuleName] -> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity BuildInfo
bi [PPSuffixHandler]
pps [ModuleName]
modules = do
let searchDirs :: [FilePath]
searchDirs = BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
bi
[FilePath]
sources <- ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
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)
External instance of the constraint type Applicative IO
External instance of the constraint type Traversable []
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 [FilePath] -> [FilePath] -> FilePath -> IO [FilePath]
findAllFilesWithExtension [FilePath]
suffixes [FilePath]
searchDirs FilePath
file
IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
External instance of the constraint type Monad IO
>>= IO [FilePath]
-> ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall {p} {a}. p -> ([a] -> p) -> [a] -> p
nonEmpty (ModuleName -> IO [FilePath]
forall {a} {a}. Pretty a => a -> IO a
External instance of the constraint type Pretty ModuleName
notFound ModuleName
module_) [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return
| ModuleName
module_ <- [ModuleName]
modules [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
otherModules BuildInfo
bi ]
[Maybe FilePath]
bootFiles <- [IO (Maybe FilePath)] -> IO [Maybe FilePath]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
External instance of the constraint type Applicative IO
External instance of the constraint type Traversable []
sequenceA
[ let file :: FilePath
file = ModuleName -> FilePath
ModuleName.toFilePath ModuleName
module_
fileExts :: [FilePath]
fileExts = [FilePath
"hs-boot", FilePath
"lhs-boot"]
in [FilePath] -> [FilePath] -> FilePath -> IO (Maybe FilePath)
findFileWithExtension [FilePath]
fileExts (BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
bi) FilePath
file
| ModuleName
module_ <- [ModuleName]
modules [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
otherModules BuildInfo
bi ]
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
sources [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes [Maybe FilePath]
bootFiles [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [FilePath]
cSources BuildInfo
bi [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [FilePath]
cxxSources BuildInfo
bi [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
BuildInfo -> [FilePath]
cmmSources BuildInfo
bi [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [FilePath]
asmSources BuildInfo
bi [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [FilePath]
jsSources BuildInfo
bi
where
nonEmpty :: p -> ([a] -> p) -> [a] -> p
nonEmpty p
x [a] -> p
_ [] = p
x
nonEmpty p
_ [a] -> p
f [a]
xs = [a] -> p
f [a]
xs
suffixes :: [FilePath]
suffixes = [PPSuffixHandler] -> [FilePath]
ppSuffixes [PPSuffixHandler]
pps [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"hs", FilePath
"lhs", FilePath
"hsig", FilePath
"lhsig"]
notFound :: a -> IO a
notFound a
m = Verbosity -> FilePath -> IO a
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO a) -> FilePath -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath
"Error: Could not find module: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Pretty a => a -> FilePath
Evidence bound by a type signature of the constraint type Pretty a
prettyShow a
m
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" with any suffix: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
show [FilePath]
suffixes FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
". If the module "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"is autogenerated it should be added to 'autogen-modules'."
printPackageProblems :: Verbosity -> PackageDescription -> IO ()
printPackageProblems :: Verbosity -> PackageDescription -> IO ()
printPackageProblems Verbosity
verbosity PackageDescription
pkg_descr = do
[PackageCheck]
ioChecks <- Verbosity
-> PackageDescription -> FilePath -> NoCallStackIO [PackageCheck]
checkPackageFiles Verbosity
verbosity PackageDescription
pkg_descr FilePath
"."
let pureChecks :: [PackageCheck]
pureChecks = PackageDescription -> [PackageCheck]
checkConfiguredPackage PackageDescription
pkg_descr
isDistError :: PackageCheck -> Bool
isDistError (PackageDistSuspicious FilePath
_) = Bool
False
isDistError (PackageDistSuspiciousWarn FilePath
_) = Bool
False
isDistError PackageCheck
_ = Bool
True
([PackageCheck]
errors, [PackageCheck]
warnings) = (PackageCheck -> Bool)
-> [PackageCheck] -> ([PackageCheck], [PackageCheck])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition PackageCheck -> Bool
isDistError ([PackageCheck]
pureChecks [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ [PackageCheck]
ioChecks)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
External instance of the constraint type Applicative IO
unless ([PackageCheck] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [PackageCheck]
errors) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Distribution quality errors:\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unlines ((PackageCheck -> FilePath) -> [PackageCheck] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map PackageCheck -> FilePath
explanation [PackageCheck]
errors)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
External instance of the constraint type Applicative IO
unless ([PackageCheck] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [PackageCheck]
warnings) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Distribution quality warnings:\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unlines ((PackageCheck -> FilePath) -> [PackageCheck] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map PackageCheck -> FilePath
explanation [PackageCheck]
warnings)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
External instance of the constraint type Applicative IO
unless ([PackageCheck] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [PackageCheck]
errors) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> FilePath -> IO ()
notice Verbosity
verbosity
FilePath
"Note: the public hackage server would reject this package."
tarBallName :: PackageDescription -> String
tarBallName :: PackageDescription -> FilePath
tarBallName = PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
External instance of the constraint type Pretty PackageIdentifier
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
External instance of the constraint type Package PackageDescription
packageId
mapAllBuildInfo :: (BuildInfo -> BuildInfo)
-> (PackageDescription -> PackageDescription)
mapAllBuildInfo :: (BuildInfo -> BuildInfo)
-> PackageDescription -> PackageDescription
mapAllBuildInfo BuildInfo -> BuildInfo
f PackageDescription
pkg = PackageDescription
pkg {
library :: Maybe Library
library = (Library -> Library) -> Maybe Library -> Maybe Library
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor Maybe
fmap Library -> Library
mapLibBi (PackageDescription -> Maybe Library
library PackageDescription
pkg),
subLibraries :: [Library]
subLibraries = (Library -> Library) -> [Library] -> [Library]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor []
fmap Library -> Library
mapLibBi (PackageDescription -> [Library]
subLibraries PackageDescription
pkg),
foreignLibs :: [ForeignLib]
foreignLibs = (ForeignLib -> ForeignLib) -> [ForeignLib] -> [ForeignLib]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor []
fmap ForeignLib -> ForeignLib
mapFLibBi (PackageDescription -> [ForeignLib]
foreignLibs PackageDescription
pkg),
executables :: [Executable]
executables = (Executable -> Executable) -> [Executable] -> [Executable]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor []
fmap Executable -> Executable
mapExeBi (PackageDescription -> [Executable]
executables PackageDescription
pkg),
testSuites :: [TestSuite]
testSuites = (TestSuite -> TestSuite) -> [TestSuite] -> [TestSuite]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor []
fmap TestSuite -> TestSuite
mapTestBi (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg),
benchmarks :: [Benchmark]
benchmarks = (Benchmark -> Benchmark) -> [Benchmark] -> [Benchmark]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor []
fmap Benchmark -> Benchmark
mapBenchBi (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg)
}
where
mapLibBi :: Library -> Library
mapLibBi Library
lib = Library
lib { libBuildInfo :: BuildInfo
libBuildInfo = BuildInfo -> BuildInfo
f (Library -> BuildInfo
libBuildInfo Library
lib) }
mapFLibBi :: ForeignLib -> ForeignLib
mapFLibBi ForeignLib
flib = ForeignLib
flib { foreignLibBuildInfo :: BuildInfo
foreignLibBuildInfo = BuildInfo -> BuildInfo
f (ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
flib) }
mapExeBi :: Executable -> Executable
mapExeBi Executable
exe = Executable
exe { buildInfo :: BuildInfo
buildInfo = BuildInfo -> BuildInfo
f (Executable -> BuildInfo
buildInfo Executable
exe) }
mapTestBi :: TestSuite -> TestSuite
mapTestBi TestSuite
tst = TestSuite
tst { testBuildInfo :: BuildInfo
testBuildInfo = BuildInfo -> BuildInfo
f (TestSuite -> BuildInfo
testBuildInfo TestSuite
tst) }
mapBenchBi :: Benchmark -> Benchmark
mapBenchBi Benchmark
bm = Benchmark
bm { benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BuildInfo -> BuildInfo
f (Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bm) }