{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.SrcDist
(
sdist
, printPackageProblems
, prepareTree
, createArchive
, prepareSnapshotTree
, snapshotPackage
, snapshotVersion
, dateToSnapshotNumber
, listPackageSources
, listPackageSourcesWithDie
) where
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.ModuleName
import qualified Distribution.ModuleName as ModuleName
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Check hiding (doesFileExist)
import Distribution.Pretty
import Distribution.Simple.BuildPaths
import Distribution.Simple.Configure (findDistPrefOrDefault)
import Distribution.Simple.Flag
import Distribution.Simple.Glob (matchDirFileGlobWithDie)
import Distribution.Simple.PreProcess
import Distribution.Simple.Program
import Distribution.Simple.Setup.SDist
import Distribution.Simple.Utils
import Distribution.Utils.Path
import Distribution.Verbosity
import Distribution.Version
import qualified Data.Map as Map
import Data.Time (UTCTime, getCurrentTime, toGregorian, utctDay)
import Distribution.Simple.Errors
import System.Directory (doesFileExist)
import System.FilePath (dropExtension, isRelative, (<.>), (</>))
import System.IO (IOMode (WriteMode), hPutStrLn, withFile)
sdist
:: PackageDescription
-> SDistFlags
-> (FilePath -> FilePath)
-> [PPSuffixHandler]
-> IO ()
sdist :: PackageDescription
-> SDistFlags
-> (FilePath -> FilePath)
-> [PPSuffixHandler]
-> IO ()
sdist PackageDescription
pkg SDistFlags
flags FilePath -> FilePath
mkTmpDir [PPSuffixHandler]
pps = do
FilePath
distPref <- Flag FilePath -> IO FilePath
findDistPrefOrDefault (Flag FilePath -> IO FilePath) -> Flag FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ SDistFlags -> Flag FilePath
sDistDistPref SDistFlags
flags
let targetPref :: FilePath
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 <- Verbosity
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources Verbosity
verbosity FilePath
"." PackageDescription
pkg [PPSuffixHandler]
pps
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Handle -> FilePath -> IO ()
hPutStrLn Handle
outHandle) [FilePath]
ordinary
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
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 <- Verbosity
-> PackageDescription -> FilePath -> FilePath -> IO FilePath
createArchive Verbosity
verbosity PackageDescription
pkg' 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 -> PackageDescription -> IO ()
generateSourceDir FilePath
targetDir PackageDescription
pkg' = do
Verbosity -> FilePath -> PackageIdentifier -> IO ()
setupMessage Verbosity
verbosity FilePath
"Building source dist for" (PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg')
Verbosity
-> PackageDescription -> FilePath -> [PPSuffixHandler] -> IO ()
prepareTree Verbosity
verbosity PackageDescription
pkg' FilePath
targetDir [PPSuffixHandler]
pps
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
snapshot (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> PackageDescription -> FilePath -> IO ()
overwriteSnapshotPackageDesc Verbosity
verbosity PackageDescription
pkg' FilePath
targetDir
verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (SDistFlags -> Flag Verbosity
sDistVerbosity SDistFlags
flags)
snapshot :: Bool
snapshot = Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (SDistFlags -> Flag Bool
sDistSnapshot SDistFlags
flags)
listPackageSources
:: Verbosity
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources :: Verbosity
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources Verbosity
verbosity FilePath
cwd PackageDescription
pkg_descr0 [PPSuffixHandler]
pps = do
Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources' Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException FilePath
cwd PackageDescription
pkg_descr [PPSuffixHandler]
pps
where
pkg_descr :: PackageDescription
pkg_descr = PackageDescription -> PackageDescription
filterAutogenModules PackageDescription
pkg_descr0
listPackageSourcesWithDie
:: Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSourcesWithDie :: Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSourcesWithDie Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd PackageDescription
pkg_descr0 [PPSuffixHandler]
pps = do
Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources' Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd PackageDescription
pkg_descr [PPSuffixHandler]
pps
where
pkg_descr :: PackageDescription
pkg_descr = PackageDescription -> PackageDescription
filterAutogenModules PackageDescription
pkg_descr0
listPackageSources'
:: Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources' :: Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources' Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd PackageDescription
pkg_descr [PPSuffixHandler]
pps =
([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[FilePath]] -> IO [FilePath])
-> ([IO [FilePath]] -> IO [[FilePath]])
-> [IO [FilePath]]
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IO [FilePath]] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([IO [FilePath]] -> IO [FilePath])
-> [IO [FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
[
([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
(IO [[FilePath]] -> IO [FilePath])
-> ((Library -> IO [FilePath]) -> IO [[FilePath]])
-> (Library -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> IO [FilePath]) -> IO [[FilePath]]
forall {f :: * -> *} {b}.
Applicative f =>
(Library -> f b) -> f [b]
withAllLib
((Library -> IO [FilePath]) -> IO [FilePath])
-> (Library -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \Library
{ exposedModules :: Library -> [ModuleName]
exposedModules = [ModuleName]
modules
, signatures :: Library -> [ModuleName]
signatures = [ModuleName]
sigs
, libBuildInfo :: Library -> BuildInfo
libBuildInfo = BuildInfo
libBi
} ->
Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd BuildInfo
libBi [PPSuffixHandler]
pps ([ModuleName]
modules [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ [ModuleName]
sigs)
,
([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
(IO [[FilePath]] -> IO [FilePath])
-> ((Executable -> IO [FilePath]) -> IO [[FilePath]])
-> (Executable -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Executable -> IO [FilePath]) -> IO [[FilePath]]
forall {f :: * -> *} {b}.
Applicative f =>
(Executable -> f b) -> f [b]
withAllExe
((Executable -> IO [FilePath]) -> IO [FilePath])
-> (Executable -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \Executable{modulePath :: Executable -> FilePath
modulePath = FilePath
mainPath, buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
exeBi} -> do
[FilePath]
biSrcs <- Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd BuildInfo
exeBi [PPSuffixHandler]
pps []
FilePath
mainSrc <- Verbosity
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> FilePath
-> IO FilePath
findMainExeFile Verbosity
verbosity FilePath
cwd BuildInfo
exeBi [PPSuffixHandler]
pps FilePath
mainPath
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
mainSrc FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
biSrcs)
,
([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
(IO [[FilePath]] -> IO [FilePath])
-> ((ForeignLib -> IO [FilePath]) -> IO [[FilePath]])
-> (ForeignLib -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ForeignLib -> IO [FilePath]) -> IO [[FilePath]]
forall {f :: * -> *} {b}.
Applicative f =>
(ForeignLib -> f b) -> f [b]
withAllFLib
((ForeignLib -> IO [FilePath]) -> IO [FilePath])
-> (ForeignLib -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \flib :: ForeignLib
flib@(ForeignLib{foreignLibBuildInfo :: ForeignLib -> BuildInfo
foreignLibBuildInfo = BuildInfo
flibBi}) -> do
[FilePath]
biSrcs <- Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd BuildInfo
flibBi [PPSuffixHandler]
pps []
[FilePath]
defFiles <-
(FilePath -> IO FilePath) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
(Verbosity
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> FilePath
-> IO FilePath
findModDefFile Verbosity
verbosity FilePath
cwd BuildInfo
flibBi [PPSuffixHandler]
pps)
(ForeignLib -> [FilePath]
foreignLibModDefFile ForeignLib
flib)
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
defFiles [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
biSrcs)
,
([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
(IO [[FilePath]] -> IO [FilePath])
-> ((TestSuite -> IO [FilePath]) -> IO [[FilePath]])
-> (TestSuite -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestSuite -> IO [FilePath]) -> IO [[FilePath]]
forall {f :: * -> *} {b}.
Applicative f =>
(TestSuite -> f b) -> f [b]
withAllTest
((TestSuite -> IO [FilePath]) -> IO [FilePath])
-> (TestSuite -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \TestSuite
t -> do
let bi :: BuildInfo
bi = TestSuite -> BuildInfo
testBuildInfo TestSuite
t
case TestSuite -> TestSuiteInterface
testInterface TestSuite
t of
TestSuiteExeV10 Version
_ FilePath
mainPath -> do
[FilePath]
biSrcs <- Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd BuildInfo
bi [PPSuffixHandler]
pps []
FilePath
srcMainFile <- Verbosity
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> FilePath
-> IO FilePath
findMainExeFile Verbosity
verbosity FilePath
cwd BuildInfo
bi [PPSuffixHandler]
pps FilePath
mainPath
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
srcMainFile FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
biSrcs)
TestSuiteLibV09 Version
_ ModuleName
m ->
Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd BuildInfo
bi [PPSuffixHandler]
pps [ModuleName
m]
TestSuiteUnsupported TestType
tp ->
Verbosity -> CabalException -> IO [FilePath]
rip Verbosity
verbosity (CabalException -> IO [FilePath])
-> CabalException -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalException
UnsupportedTestSuite (TestType -> FilePath
forall a. Show a => a -> FilePath
show TestType
tp)
,
([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
(IO [[FilePath]] -> IO [FilePath])
-> ((Benchmark -> IO [FilePath]) -> IO [[FilePath]])
-> (Benchmark -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Benchmark -> IO [FilePath]) -> IO [[FilePath]]
forall {f :: * -> *} {b}.
Applicative f =>
(Benchmark -> f b) -> f [b]
withAllBenchmark
((Benchmark -> IO [FilePath]) -> IO [FilePath])
-> (Benchmark -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \Benchmark
bm -> do
let bi :: BuildInfo
bi = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bm
case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
BenchmarkExeV10 Version
_ FilePath
mainPath -> do
[FilePath]
biSrcs <- Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd BuildInfo
bi [PPSuffixHandler]
pps []
FilePath
srcMainFile <- Verbosity
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> FilePath
-> IO FilePath
findMainExeFile Verbosity
verbosity FilePath
cwd BuildInfo
bi [PPSuffixHandler]
pps FilePath
mainPath
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
srcMainFile FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
biSrcs)
BenchmarkUnsupported BenchmarkType
tp ->
Verbosity -> CabalException -> IO [FilePath]
rip Verbosity
verbosity (CabalException -> IO [FilePath])
-> CabalException -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalException
UnsupportedBenchMark (BenchmarkType -> FilePath
forall a. Show a => a -> FilePath
show BenchmarkType
tp)
,
([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
(IO [[FilePath]] -> IO [FilePath])
-> ((FilePath -> IO [FilePath]) -> IO [[FilePath]])
-> (FilePath -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PackageDescription -> [FilePath]
dataFiles PackageDescription
pkg_descr)
((FilePath -> IO [FilePath]) -> IO [FilePath])
-> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
filename ->
do
let srcDataDirRaw :: FilePath
srcDataDirRaw = PackageDescription -> FilePath
dataDir PackageDescription
pkg_descr
srcDataDir :: FilePath
srcDataDir
| FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
srcDataDirRaw = FilePath
"."
| Bool
otherwise = FilePath
srcDataDirRaw
Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> CabalSpecVersion
-> FilePath
-> FilePath
-> IO [FilePath]
matchDirFileGlobWithDie Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) FilePath
cwd (FilePath
srcDataDir FilePath -> FilePath -> FilePath
</> FilePath
filename)
,
([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[FilePath]] -> IO [FilePath])
-> ((FilePath -> IO [FilePath]) -> IO [[FilePath]])
-> (FilePath -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PackageDescription -> [FilePath]
extraSrcFiles PackageDescription
pkg_descr) ((FilePath -> IO [FilePath]) -> IO [FilePath])
-> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
fpath ->
Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> CabalSpecVersion
-> FilePath
-> FilePath
-> IO [FilePath]
matchDirFileGlobWithDie Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) FilePath
cwd FilePath
fpath
,
([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
(IO [[FilePath]] -> IO [FilePath])
-> ((FilePath -> IO [FilePath]) -> IO [[FilePath]])
-> (FilePath -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PackageDescription -> [FilePath]
extraDocFiles PackageDescription
pkg_descr)
((FilePath -> IO [FilePath]) -> IO [FilePath])
-> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
filename ->
Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> CabalSpecVersion
-> FilePath
-> FilePath
-> IO [FilePath]
matchDirFileGlobWithDie Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) FilePath
cwd FilePath
filename
,
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SymbolicPath PackageDir LicenseFile -> FilePath)
-> [SymbolicPath PackageDir LicenseFile] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir LicenseFile -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath ([SymbolicPath PackageDir LicenseFile] -> [FilePath])
-> [SymbolicPath PackageDir LicenseFile] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles PackageDescription
pkg_descr)
,
([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
(IO [[FilePath]] -> IO [FilePath])
-> ((Library -> IO [FilePath]) -> IO [[FilePath]])
-> (Library -> IO [FilePath])
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> IO [FilePath]) -> IO [[FilePath]]
forall {f :: * -> *} {b}.
Applicative f =>
(Library -> f b) -> f [b]
withAllLib
((Library -> IO [FilePath]) -> IO [FilePath])
-> (Library -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \Library
l -> do
let lbi :: BuildInfo
lbi = Library -> BuildInfo
libBuildInfo Library
l
incls :: [FilePath]
incls = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` BuildInfo -> [FilePath]
autogenIncludes BuildInfo
lbi) (BuildInfo -> [FilePath]
installIncludes BuildInfo
lbi)
relincdirs :: [FilePath]
relincdirs = FilePath
"." FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isRelative (BuildInfo -> [FilePath]
includeDirs BuildInfo
lbi)
(FilePath -> IO FilePath) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((FilePath, FilePath) -> FilePath)
-> IO (FilePath, FilePath) -> IO FilePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd (IO (FilePath, FilePath) -> IO FilePath)
-> (FilePath -> IO (FilePath, FilePath)) -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity
-> FilePath -> [FilePath] -> FilePath -> IO (FilePath, FilePath)
findIncludeFile Verbosity
verbosity FilePath
cwd [FilePath]
relincdirs) [FilePath]
incls
,
(Maybe FilePath -> [FilePath])
-> IO (Maybe FilePath) -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath]
-> (FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FilePath
f -> [FilePath
f])) (IO (Maybe FilePath) -> IO [FilePath])
-> IO (Maybe FilePath) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe FilePath)
findSetupFile FilePath
cwd
,
(FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FilePath
d -> [FilePath
d]) (Verbosity -> FilePath -> FilePath -> IO FilePath
tryFindPackageDescCwd Verbosity
verbosity FilePath
cwd FilePath
".")
]
where
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)
prepareTree
:: Verbosity
-> PackageDescription
-> FilePath
-> [PPSuffixHandler]
-> IO ()
prepareTree :: Verbosity
-> PackageDescription -> FilePath -> [PPSuffixHandler] -> IO ()
prepareTree Verbosity
verbosity PackageDescription
pkg_descr0 FilePath
targetDir [PPSuffixHandler]
pps = do
[FilePath]
ordinary <- Verbosity
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources Verbosity
verbosity FilePath
"." PackageDescription
pkg_descr [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)
FilePath -> IO ()
maybeCreateDefaultSetupScript FilePath
targetDir
where
pkg_descr :: PackageDescription
pkg_descr = PackageDescription -> PackageDescription
filterAutogenModules PackageDescription
pkg_descr0
findSetupFile :: FilePath -> IO (Maybe FilePath)
findSetupFile :: FilePath -> IO (Maybe FilePath)
findSetupFile FilePath
targetDir = do
Bool
hsExists <- FilePath -> IO Bool
doesFileExist (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
setupHs)
Bool
lhsExists <- FilePath -> IO Bool
doesFileExist (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
setupLhs)
if Bool
hsExists
then Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
setupHs)
else
if Bool
lhsExists
then Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
setupLhs)
else Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
where
setupHs :: FilePath
setupHs = FilePath
"Setup.hs"
setupLhs :: FilePath
setupLhs = FilePath
"Setup.lhs"
maybeCreateDefaultSetupScript :: FilePath -> IO ()
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe FilePath
Nothing -> do
FilePath -> FilePath -> IO ()
writeUTF8File (FilePath
targetDir FilePath -> FilePath -> FilePath
</> FilePath
"Setup.hs") (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
[FilePath] -> FilePath
unlines
[ FilePath
"import Distribution.Simple"
, FilePath
"main = defaultMain"
]
findMainExeFile
:: Verbosity
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> FilePath
-> IO FilePath
findMainExeFile :: Verbosity
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> FilePath
-> IO FilePath
findMainExeFile Verbosity
verbosity FilePath
cwd BuildInfo
exeBi [PPSuffixHandler]
pps FilePath
mainPath = do
Maybe FilePath
ppFile <-
FilePath
-> [Suffix] -> [FilePath] -> FilePath -> IO (Maybe FilePath)
findFileCwdWithExtension
FilePath
cwd
([PPSuffixHandler] -> [Suffix]
ppSuffixes [PPSuffixHandler]
pps)
((SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
exeBi))
(FilePath -> FilePath
dropExtension FilePath
mainPath)
case Maybe FilePath
ppFile of
Maybe FilePath
Nothing -> Verbosity -> FilePath -> [FilePath] -> FilePath -> IO FilePath
findFileCwd Verbosity
verbosity FilePath
cwd ((SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
exeBi)) FilePath
mainPath
Just FilePath
pp -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
pp
findModDefFile
:: Verbosity -> FilePath -> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath
findModDefFile :: Verbosity
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> FilePath
-> IO FilePath
findModDefFile Verbosity
verbosity FilePath
cwd BuildInfo
flibBi [PPSuffixHandler]
_pps FilePath
modDefPath =
Verbosity -> FilePath -> [FilePath] -> FilePath -> IO FilePath
findFileCwd Verbosity
verbosity FilePath
cwd (FilePath
"." FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
flibBi)) FilePath
modDefPath
findIncludeFile :: Verbosity -> FilePath -> [FilePath] -> String -> IO (String, FilePath)
findIncludeFile :: Verbosity
-> FilePath -> [FilePath] -> FilePath -> IO (FilePath, FilePath)
findIncludeFile Verbosity
verbosity FilePath
_ [] FilePath
f = Verbosity -> CabalException -> IO (FilePath, FilePath)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO (FilePath, FilePath))
-> CabalException -> IO (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalException
NoIncludeFileFound FilePath
f
findIncludeFile Verbosity
verbosity FilePath
cwd (FilePath
d : [FilePath]
ds) FilePath
f = do
let path :: FilePath
path = (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
f)
Bool
b <- FilePath -> IO Bool
doesFileExist (FilePath
cwd FilePath -> FilePath -> FilePath
</> FilePath
path)
if Bool
b then (FilePath, FilePath) -> IO (FilePath, FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
f, FilePath
path) else Verbosity
-> FilePath -> [FilePath] -> FilePath -> IO (FilePath, FilePath)
findIncludeFile Verbosity
verbosity FilePath
cwd [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 = 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)
prepareSnapshotTree
:: Verbosity
-> PackageDescription
-> FilePath
-> [PPSuffixHandler]
-> IO ()
prepareSnapshotTree :: Verbosity
-> PackageDescription -> FilePath -> [PPSuffixHandler] -> IO ()
prepareSnapshotTree Verbosity
verbosity PackageDescription
pkg FilePath
targetDir [PPSuffixHandler]
pps = do
Verbosity
-> PackageDescription -> FilePath -> [PPSuffixHandler] -> IO ()
prepareTree Verbosity
verbosity PackageDescription
pkg FilePath
targetDir [PPSuffixHandler]
pps
Verbosity -> PackageDescription -> FilePath -> IO ()
overwriteSnapshotPackageDesc Verbosity
verbosity PackageDescription
pkg FilePath
targetDir
overwriteSnapshotPackageDesc
:: Verbosity
-> 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
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
`isPrefixOf` (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
line =
FilePath
"version: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
version
| Bool
otherwise = FilePath
line
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
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 -> (Year, Int, Int)
toGregorian (UTCTime -> Day
utctDay UTCTime
date) of
(Year
year, Int
month, Int
day) ->
Year -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Year
year Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10000
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
month Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
day
createArchive
:: Verbosity
-> PackageDescription
-> FilePath
-> FilePath
-> IO FilePath
createArchive :: Verbosity
-> PackageDescription -> FilePath -> FilePath -> IO FilePath
createArchive Verbosity
verbosity PackageDescription
pkg_descr FilePath
tmpDir FilePath
targetPref = do
let tarBallFilePath :: FilePath
tarBallFilePath = FilePath
targetPref FilePath -> FilePath -> FilePath
</> PackageDescription -> FilePath
tarBallName PackageDescription
pkg_descr FilePath -> FilePath -> FilePath
<.> FilePath
"tar.gz"
(ConfiguredProgram
tarProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
tarProgram ProgramDb
defaultProgramDb
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
== FilePath
"YES") (Maybe FilePath -> Bool) -> Maybe FilePath -> Bool
forall a b. (a -> b) -> a -> b
$
FilePath -> Map FilePath FilePath -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup
FilePath
"Supports --format"
(ConfiguredProgram -> Map FilePath FilePath
programProperties ConfiguredProgram
tarProg)
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 -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
tarBallFilePath
allSourcesBuildInfo
:: Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo :: Verbosity
-> (Verbosity -> CabalException -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> CabalException -> IO [FilePath]
rip FilePath
cwd BuildInfo
bi [PPSuffixHandler]
pps [ModuleName]
modules = do
let searchDirs :: [FilePath]
searchDirs = (SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)
[FilePath]
sources <-
([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[FilePath]] -> IO [FilePath])
-> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$
[IO [FilePath]] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([IO [FilePath]] -> IO [[FilePath]])
-> [IO [FilePath]] -> IO [[FilePath]]
forall a b. (a -> b) -> a -> b
$
[ let file :: FilePath
file = ModuleName -> FilePath
ModuleName.toFilePath ModuleName
module_
in
FilePath -> [Suffix] -> [FilePath] -> FilePath -> IO [FilePath]
findAllFilesCwdWithExtension FilePath
cwd [Suffix]
suffixes [FilePath]
searchDirs FilePath
file
IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO [FilePath]
-> ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall b a. b -> ([a] -> b) -> [a] -> b
nonEmpty' (ModuleName -> IO [FilePath]
notFound ModuleName
module_) [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
| ModuleName
module_ <- [ModuleName]
modules [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
otherModules BuildInfo
bi
]
[Maybe FilePath]
bootFiles <-
[IO (Maybe FilePath)] -> IO [Maybe FilePath]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA
[ let file :: FilePath
file = ModuleName -> FilePath
ModuleName.toFilePath ModuleName
module_
fileExts :: [Suffix]
fileExts = [Suffix]
builtinHaskellBootSuffixes
in FilePath
-> [Suffix] -> [FilePath] -> FilePath -> IO (Maybe FilePath)
findFileCwdWithExtension FilePath
cwd [Suffix]
fileExts ((SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)) FilePath
file
| ModuleName
module_ <- [ModuleName]
modules [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
otherModules BuildInfo
bi
]
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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' :: b -> ([a] -> b) -> [a] -> b
nonEmpty' :: forall b a. b -> ([a] -> b) -> [a] -> b
nonEmpty' b
x [a] -> b
_ [] = b
x
nonEmpty' b
_ [a] -> b
f [a]
xs = [a] -> b
f [a]
xs
suffixes :: [Suffix]
suffixes = [PPSuffixHandler] -> [Suffix]
ppSuffixes [PPSuffixHandler]
pps [Suffix] -> [Suffix] -> [Suffix]
forall a. [a] -> [a] -> [a]
++ [Suffix]
builtinHaskellSuffixes
notFound :: ModuleName -> IO [FilePath]
notFound :: ModuleName -> IO [FilePath]
notFound ModuleName
m =
Verbosity -> CabalException -> IO [FilePath]
rip Verbosity
verbosity (CabalException -> IO [FilePath])
-> CabalException -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ ModuleName -> [Suffix] -> CabalException
NoModuleFound ModuleName
m [Suffix]
suffixes
printPackageProblems :: Verbosity -> PackageDescription -> IO ()
printPackageProblems :: Verbosity -> PackageDescription -> IO ()
printPackageProblems Verbosity
verbosity PackageDescription
pkg_descr = do
[PackageCheck]
ioChecks <- Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck]
checkPackageFiles Verbosity
verbosity PackageDescription
pkg_descr FilePath
"."
let pureChecks :: [PackageCheck]
pureChecks = PackageDescription -> [PackageCheck]
checkConfiguredPackage PackageDescription
pkg_descr
([PackageCheck]
errors, [PackageCheck]
warnings) = (PackageCheck -> Bool)
-> [PackageCheck] -> ([PackageCheck], [PackageCheck])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition PackageCheck -> Bool
isHackageDistError ([PackageCheck]
pureChecks [PackageCheck] -> [PackageCheck] -> [PackageCheck]
forall a. [a] -> [a] -> [a]
++ [PackageCheck]
ioChecks)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PackageCheck] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
errors) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> 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
ppPackageCheck [PackageCheck]
errors)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PackageCheck] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
warnings) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> 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
ppPackageCheck [PackageCheck]
warnings)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PackageCheck] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
errors) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> 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
prettyShow (PackageIdentifier -> FilePath)
-> (PackageDescription -> PackageIdentifier)
-> PackageDescription
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId
mapAllBuildInfo
:: (BuildInfo -> BuildInfo)
-> (PackageDescription -> PackageDescription)
mapAllBuildInfo :: (BuildInfo -> BuildInfo)
-> PackageDescription -> PackageDescription
mapAllBuildInfo BuildInfo -> BuildInfo
f PackageDescription
pkg =
PackageDescription
pkg
{ library = fmap mapLibBi (library pkg)
, subLibraries = fmap mapLibBi (subLibraries pkg)
, foreignLibs = fmap mapFLibBi (foreignLibs pkg)
, executables = fmap mapExeBi (executables pkg)
, testSuites = fmap mapTestBi (testSuites pkg)
, benchmarks = fmap mapBenchBi (benchmarks pkg)
}
where
mapLibBi :: Library -> Library
mapLibBi Library
lib = Library
lib{libBuildInfo = f (libBuildInfo lib)}
mapFLibBi :: ForeignLib -> ForeignLib
mapFLibBi ForeignLib
flib = ForeignLib
flib{foreignLibBuildInfo = f (foreignLibBuildInfo flib)}
mapExeBi :: Executable -> Executable
mapExeBi Executable
exe = Executable
exe{buildInfo = f (buildInfo exe)}
mapTestBi :: TestSuite -> TestSuite
mapTestBi TestSuite
tst = TestSuite
tst{testBuildInfo = f (testBuildInfo tst)}
mapBenchBi :: Benchmark -> Benchmark
mapBenchBi Benchmark
bm = Benchmark
bm{benchmarkBuildInfo = f (benchmarkBuildInfo bm)}