{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Stack.Package
( readDotBuildinfo
, resolvePackage
, packageFromPackageDescription
, Package (..)
, PackageDescriptionPair (..)
, GetPackageOpts (..)
, PackageConfig (..)
, buildLogPath
, PackageException (..)
, resolvePackageDescription
, packageDependencies
, applyForceCustomBuild
) where
import Data.List ( unzip )
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified Data.Text as T
import Distribution.CabalSpecVersion
import Distribution.Compiler
import Distribution.Package
hiding
( Package, packageName, packageVersion, PackageIdentifier )
import Distribution.PackageDescription hiding ( FlagName )
#if !MIN_VERSION_Cabal(3,8,1)
import Distribution.PackageDescription.Parsec
#endif
import Distribution.Pretty ( prettyShow )
#if MIN_VERSION_Cabal(3,8,1)
import Distribution.Simple.PackageDescription ( readHookedBuildInfo )
#endif
import Distribution.System ( OS (..), Arch, Platform (..) )
import Distribution.Text ( display )
import qualified Distribution.Types.CondTree as Cabal
import qualified Distribution.Types.ExeDependency as Cabal
import qualified Distribution.Types.LegacyExeDependency as Cabal
import Distribution.Types.MungedPackageName
import qualified Distribution.Types.UnqualComponentName as Cabal
import Distribution.Utils.Path ( getSymbolicPath )
import Distribution.Verbosity ( silent )
import Distribution.Version ( mkVersion, orLaterVersion, anyVersion )
import Path as FL hiding ( replaceExtension )
import Path.Extra
import Path.IO hiding ( findFiles )
import Stack.Build.Installed
import Stack.Constants
import Stack.Constants.Config
import Stack.Prelude hiding ( Display (..) )
import Stack.Types.Compiler
import Stack.Types.Config
import Stack.Types.GhcPkgId
import Stack.Types.NamedComponent
import Stack.Types.Package
import Stack.Types.Version
import System.FilePath ( replaceExtension )
import Stack.Types.Dependency ( DepValue (..), DepType (..) )
import Stack.Types.PackageFile
( GetPackageFileContext (..), DotCabalPath
, GetPackageFiles (..)
)
import Stack.PackageFile ( packageDescModulesAndFiles )
import Stack.ComponentFile
readDotBuildinfo :: MonadIO m
=> Path Abs File
-> m HookedBuildInfo
readDotBuildinfo :: forall (m :: * -> *).
MonadIO m =>
Path Abs File -> m HookedBuildInfo
readDotBuildinfo Path Abs File
buildinfofp =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> IO HookedBuildInfo
readHookedBuildInfo Verbosity
silent (forall b t. Path b t -> String
toFilePath Path Abs File
buildinfofp)
resolvePackage :: PackageConfig
-> GenericPackageDescription
-> Package
resolvePackage :: PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
packageConfig GenericPackageDescription
gpkg =
PackageConfig -> [PackageFlag] -> PackageDescriptionPair -> Package
packageFromPackageDescription
PackageConfig
packageConfig
(GenericPackageDescription -> [PackageFlag]
genPackageFlags GenericPackageDescription
gpkg)
(PackageConfig
-> GenericPackageDescription -> PackageDescriptionPair
resolvePackageDescription PackageConfig
packageConfig GenericPackageDescription
gpkg)
packageFromPackageDescription :: PackageConfig
-> [PackageFlag]
-> PackageDescriptionPair
-> Package
packageFromPackageDescription :: PackageConfig -> [PackageFlag] -> PackageDescriptionPair -> Package
packageFromPackageDescription PackageConfig
packageConfig [PackageFlag]
pkgFlags (PackageDescriptionPair PackageDescription
pkgNoMod PackageDescription
pkg) =
Package
{ packageName :: PackageName
packageName = PackageName
name
, packageVersion :: Version
packageVersion = PackageIdentifier -> Version
pkgVersion PackageIdentifier
pkgId
, packageLicense :: Either License License
packageLicense = PackageDescription -> Either License License
licenseRaw PackageDescription
pkg
, packageDeps :: Map PackageName DepValue
packageDeps = Map PackageName DepValue
deps
, packageFiles :: GetPackageFiles
packageFiles = GetPackageFiles
pkgFiles
, packageUnknownTools :: Set ExeName
packageUnknownTools = Set ExeName
unknownTools
, packageGhcOptions :: [Text]
packageGhcOptions = PackageConfig -> [Text]
packageConfigGhcOptions PackageConfig
packageConfig
, packageCabalConfigOpts :: [Text]
packageCabalConfigOpts = PackageConfig -> [Text]
packageConfigCabalConfigOpts PackageConfig
packageConfig
, packageFlags :: Map FlagName Bool
packageFlags = PackageConfig -> Map FlagName Bool
packageConfigFlags PackageConfig
packageConfig
, packageDefaultFlags :: Map FlagName Bool
packageDefaultFlags = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[(PackageFlag -> FlagName
flagName PackageFlag
flag, PackageFlag -> Bool
flagDefault PackageFlag
flag) | PackageFlag
flag <- [PackageFlag]
pkgFlags]
, packageAllDeps :: Set PackageName
packageAllDeps = forall k a. Map k a -> Set k
M.keysSet Map PackageName DepValue
deps
, packageLibraries :: PackageLibraries
packageLibraries =
let mlib :: Maybe Library
mlib = do
Library
lib <- PackageDescription -> Maybe Library
library PackageDescription
pkg
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ BuildInfo -> Bool
buildable forall a b. (a -> b) -> a -> b
$ Library -> BuildInfo
libBuildInfo Library
lib
forall a. a -> Maybe a
Just Library
lib
in
case Maybe Library
mlib of
Maybe Library
Nothing -> PackageLibraries
NoLibraries
Just Library
_ -> Set Text -> PackageLibraries
HasLibraries Set Text
foreignLibNames
, packageInternalLibraries :: Set Text
packageInternalLibraries = Set Text
subLibNames
, packageTests :: Map Text TestSuiteInterface
packageTests = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[(String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName forall a b. (a -> b) -> a -> b
$ TestSuite -> UnqualComponentName
testName TestSuite
t), TestSuite -> TestSuiteInterface
testInterface TestSuite
t)
| TestSuite
t <- PackageDescription -> [TestSuite]
testSuites PackageDescription
pkgNoMod
, BuildInfo -> Bool
buildable (TestSuite -> BuildInfo
testBuildInfo TestSuite
t)
]
, packageBenchmarks :: Set Text
packageBenchmarks = forall a. Ord a => [a] -> Set a
S.fromList
[String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName forall a b. (a -> b) -> a -> b
$ Benchmark -> UnqualComponentName
benchmarkName Benchmark
b)
| Benchmark
b <- PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkgNoMod
, BuildInfo -> Bool
buildable (Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
b)
]
, packageExes :: Set Text
packageExes = forall a. Ord a => [a] -> Set a
S.fromList
[String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
biBuildInfo)
| Executable
biBuildInfo <- PackageDescription -> [Executable]
executables PackageDescription
pkg
, BuildInfo -> Bool
buildable (Executable -> BuildInfo
buildInfo Executable
biBuildInfo)]
, packageOpts :: GetPackageOpts
packageOpts = (forall env.
HasEnvConfig env =>
InstallMap
-> InstalledMap
-> [PackageName]
-> [PackageName]
-> Path Abs File
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath],
Map NamedComponent BuildInfoOpts))
-> GetPackageOpts
GetPackageOpts forall a b. (a -> b) -> a -> b
$
\InstallMap
installMap InstalledMap
installedMap [PackageName]
omitPkgs [PackageName]
addPkgs Path Abs File
cabalfp ->
do (Map NamedComponent (Map ModuleName (Path Abs File))
componentsModules,Map NamedComponent [DotCabalPath]
componentFiles,Set (Path Abs File)
_,[PackageWarning]
_) <- GetPackageFiles
-> forall env.
HasEnvConfig env =>
Path Abs File
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
getPackageFiles GetPackageFiles
pkgFiles Path Abs File
cabalfp
let internals :: [Text]
internals = forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ Set NamedComponent -> Set Text
internalLibComponents forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> Set k
M.keysSet Map NamedComponent (Map ModuleName (Path Abs File))
componentsModules
[PackageName]
excludedInternals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *). MonadThrow m => String -> m PackageName
parsePackageNameThrowing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
internals
[PackageName]
mungedInternals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *). MonadThrow m => String -> m PackageName
parsePackageNameThrowing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Text
toInternalPackageMungedName) [Text]
internals
Map NamedComponent BuildInfoOpts
componentsOpts <-
forall env (m :: * -> *).
(HasEnvConfig env, MonadThrow m, MonadReader env m, MonadIO m) =>
InstallMap
-> InstalledMap
-> [PackageName]
-> [PackageName]
-> Path Abs File
-> PackageDescription
-> Map NamedComponent [DotCabalPath]
-> m (Map NamedComponent BuildInfoOpts)
generatePkgDescOpts InstallMap
installMap InstalledMap
installedMap
([PackageName]
excludedInternals forall a. [a] -> [a] -> [a]
++ [PackageName]
omitPkgs) ([PackageName]
mungedInternals forall a. [a] -> [a] -> [a]
++ [PackageName]
addPkgs)
Path Abs File
cabalfp PackageDescription
pkg Map NamedComponent [DotCabalPath]
componentFiles
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map NamedComponent (Map ModuleName (Path Abs File))
componentsModules,Map NamedComponent [DotCabalPath]
componentFiles,Map NamedComponent BuildInfoOpts
componentsOpts)
, packageHasExposedModules :: Bool
packageHasExposedModules = forall b a. b -> (a -> b) -> Maybe a -> b
maybe
Bool
False
(Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> [ModuleName]
exposedModules)
(PackageDescription -> Maybe Library
library PackageDescription
pkg)
, packageBuildType :: BuildType
packageBuildType = PackageDescription -> BuildType
buildType PackageDescription
pkg
, packageSetupDeps :: Maybe (Map PackageName VersionRange)
packageSetupDeps = Maybe (Map PackageName VersionRange)
msetupDeps
, packageCabalSpec :: CabalSpecVersion
packageCabalSpec = PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg
}
where
extraLibNames :: Set Text
extraLibNames = forall a. Ord a => Set a -> Set a -> Set a
S.union Set Text
subLibNames Set Text
foreignLibNames
subLibNames :: Set Text
subLibNames
= forall a. Ord a => [a] -> Set a
S.fromList
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
Cabal.unUnqualComponentName)
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LibraryName -> Maybe UnqualComponentName
libraryNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName)
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> Bool
buildable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo)
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Library]
subLibraries PackageDescription
pkg
foreignLibNames :: Set Text
foreignLibNames
= forall a. Ord a => [a] -> Set a
S.fromList
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
Cabal.unUnqualComponentName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> UnqualComponentName
foreignLibName)
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> Bool
buildable forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> BuildInfo
foreignLibBuildInfo)
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [ForeignLib]
foreignLibs PackageDescription
pkg
toInternalPackageMungedName :: Text -> Text
toInternalPackageMungedName
= String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> LibraryName -> MungedPackageName
MungedPackageName (PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UnqualComponentName -> LibraryName
maybeToLibraryName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UnqualComponentName
Cabal.mkUnqualComponentName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
pkgFiles :: GetPackageFiles
pkgFiles = (forall env.
HasEnvConfig env =>
Path Abs File
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning]))
-> GetPackageFiles
GetPackageFiles forall a b. (a -> b) -> a -> b
$
\Path Abs File
cabalfp -> forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m,
MonadUnliftIO m) =>
StyleDoc -> m a -> m a
debugBracket (StyleDoc
"getPackageFiles" StyleDoc -> StyleDoc -> StyleDoc
<+> forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
cabalfp) forall a b. (a -> b) -> a -> b
$ do
let pkgDir :: Path Abs Dir
pkgDir = forall b t. Path b t -> Path b Dir
parent Path Abs File
cabalfp
Path Abs Dir
distDir <- forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs Dir)
distDirFromDir Path Abs Dir
pkgDir
BuildConfig
bc <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL
Version
cabalVer <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasCompiler env => SimpleGetter env Version
cabalVersionL
(Map NamedComponent (Map ModuleName (Path Abs File))
componentModules,Map NamedComponent [DotCabalPath]
componentFiles,Set (Path Abs File)
dataFiles',[PackageWarning]
warnings) <-
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO
(Path Abs File
-> Path Abs Dir -> BuildConfig -> Version -> GetPackageFileContext
GetPackageFileContext Path Abs File
cabalfp Path Abs Dir
distDir BuildConfig
bc Version
cabalVer)
(PackageDescription
-> RIO
GetPackageFileContext
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
packageDescModulesAndFiles PackageDescription
pkg)
Set (Path Abs File)
setupFiles <-
if PackageDescription -> BuildType
buildType PackageDescription
pkg forall a. Eq a => a -> a -> Bool
== BuildType
Custom
then do
let setupHsPath :: Path Abs File
setupHsPath = Path Abs Dir
pkgDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileSetupHs
setupLhsPath :: Path Abs File
setupLhsPath = Path Abs Dir
pkgDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileSetupLhs
Bool
setupHsExists <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
setupHsPath
if Bool
setupHsExists then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Set a
S.singleton Path Abs File
setupHsPath) else do
Bool
setupLhsExists <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
setupLhsPath
if Bool
setupLhsExists then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Set a
S.singleton Path Abs File
setupLhsPath) else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Set a
S.empty
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Set a
S.empty
Set (Path Abs File)
buildFiles <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Ord a => a -> Set a -> Set a
S.insert Path Abs File
cabalfp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => Set a -> Set a -> Set a
S.union Set (Path Abs File)
setupFiles) forall a b. (a -> b) -> a -> b
$ do
let hpackPath :: Path Abs File
hpackPath = Path Abs Dir
pkgDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileHpackPackageConfig
Bool
hpackExists <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
hpackPath
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
hpackExists then forall a. a -> Set a
S.singleton Path Abs File
hpackPath else forall a. Set a
S.empty
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map NamedComponent (Map ModuleName (Path Abs File))
componentModules, Map NamedComponent [DotCabalPath]
componentFiles, Set (Path Abs File)
buildFiles forall a. Semigroup a => a -> a -> a
<> Set (Path Abs File)
dataFiles', [PackageWarning]
warnings)
pkgId :: PackageIdentifier
pkgId = PackageDescription -> PackageIdentifier
package PackageDescription
pkg
name :: PackageName
name = PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId
(Set ExeName
unknownTools, Map PackageName DepValue
knownTools) = PackageDescription -> (Set ExeName, Map PackageName DepValue)
packageDescTools PackageDescription
pkg
deps :: Map PackageName DepValue
deps = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> Bool
isMe) (forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith forall a. Semigroup a => a -> a -> a
(<>)
[ VersionRange -> DepValue
asLibrary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageConfig -> PackageDescription -> Map PackageName VersionRange
packageDependencies PackageConfig
packageConfig PackageDescription
pkg
, VersionRange -> DepValue
asLibrary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
M.empty Maybe (Map PackageName VersionRange)
msetupDeps
, Map PackageName DepValue
knownTools
])
msetupDeps :: Maybe (Map PackageName VersionRange)
msetupDeps = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Dependency -> PackageName
depPkgName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Dependency -> VersionRange
depVerRange) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetupBuildInfo -> [Dependency]
setupDepends)
(PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg)
asLibrary :: VersionRange -> DepValue
asLibrary VersionRange
range = DepValue
{ dvVersionRange :: VersionRange
dvVersionRange = VersionRange
range
, dvType :: DepType
dvType = DepType
AsLibrary
}
isMe :: PackageName -> Bool
isMe PackageName
name' = PackageName
name' forall a. Eq a => a -> a -> Bool
== PackageName
name Bool -> Bool -> Bool
|| forall a. IsString a => String -> a
fromString (PackageName -> String
packageNameString PackageName
name') forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
extraLibNames
generatePkgDescOpts
:: (HasEnvConfig env, MonadThrow m, MonadReader env m, MonadIO m)
=> InstallMap
-> InstalledMap
-> [PackageName]
-> [PackageName]
-> Path Abs File
-> PackageDescription
-> Map NamedComponent [DotCabalPath]
-> m (Map NamedComponent BuildInfoOpts)
generatePkgDescOpts :: forall env (m :: * -> *).
(HasEnvConfig env, MonadThrow m, MonadReader env m, MonadIO m) =>
InstallMap
-> InstalledMap
-> [PackageName]
-> [PackageName]
-> Path Abs File
-> PackageDescription
-> Map NamedComponent [DotCabalPath]
-> m (Map NamedComponent BuildInfoOpts)
generatePkgDescOpts InstallMap
installMap InstalledMap
installedMap [PackageName]
omitPkgs [PackageName]
addPkgs Path Abs File
cabalfp PackageDescription
pkg Map NamedComponent [DotCabalPath]
componentPaths = do
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
Version
cabalVer <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasCompiler env => SimpleGetter env Version
cabalVersionL
Path Abs Dir
distDir <- forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs Dir)
distDirFromDir Path Abs Dir
cabalDir
let generate :: NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate NamedComponent
namedComponent BuildInfo
binfo =
( NamedComponent
namedComponent
, BioInput -> BuildInfoOpts
generateBuildInfoOpts BioInput
{ biInstallMap :: InstallMap
biInstallMap = InstallMap
installMap
, biInstalledMap :: InstalledMap
biInstalledMap = InstalledMap
installedMap
, biCabalDir :: Path Abs Dir
biCabalDir = Path Abs Dir
cabalDir
, biDistDir :: Path Abs Dir
biDistDir = Path Abs Dir
distDir
, biOmitPackages :: [PackageName]
biOmitPackages = [PackageName]
omitPkgs
, biAddPackages :: [PackageName]
biAddPackages = [PackageName]
addPkgs
, biBuildInfo :: BuildInfo
biBuildInfo = BuildInfo
binfo
, biDotCabalPaths :: [DotCabalPath]
biDotCabalPaths = forall a. a -> Maybe a -> a
fromMaybe [] (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup NamedComponent
namedComponent Map NamedComponent [DotCabalPath]
componentPaths)
, biConfigLibDirs :: [String]
biConfigLibDirs = Config -> [String]
configExtraLibDirs Config
config
, biConfigIncludeDirs :: [String]
biConfigIncludeDirs = Config -> [String]
configExtraIncludeDirs Config
config
, biComponentName :: NamedComponent
biComponentName = NamedComponent
namedComponent
, biCabalVersion :: Version
biCabalVersion = Version
cabalVer
}
)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
(forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ forall b a. b -> (a -> b) -> Maybe a -> b
maybe
[]
(forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate NamedComponent
CLib forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo)
(PackageDescription -> Maybe Library
library PackageDescription
pkg)
, forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(\Library
sublib -> do
let maybeLib :: Maybe NamedComponent
maybeLib = Text -> NamedComponent
CInternalLib forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
Cabal.unUnqualComponentName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LibraryName -> Maybe UnqualComponentName
libraryNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName) Library
sublib
forall a b c. (a -> b -> c) -> b -> a -> c
flip NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate (Library -> BuildInfo
libBuildInfo Library
sublib) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NamedComponent
maybeLib
)
(PackageDescription -> [Library]
subLibraries PackageDescription
pkg)
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\Executable
exe ->
NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate
(Text -> NamedComponent
CExe (String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName (Executable -> UnqualComponentName
exeName Executable
exe))))
(Executable -> BuildInfo
buildInfo Executable
exe))
(PackageDescription -> [Executable]
executables PackageDescription
pkg)
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\Benchmark
bench ->
NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate
(Text -> NamedComponent
CBench (String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName (Benchmark -> UnqualComponentName
benchmarkName Benchmark
bench))))
(Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bench))
(PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg)
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\TestSuite
test ->
NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate
(Text -> NamedComponent
CTest (String -> Text
T.pack (UnqualComponentName -> String
Cabal.unUnqualComponentName (TestSuite -> UnqualComponentName
testName TestSuite
test))))
(TestSuite -> BuildInfo
testBuildInfo TestSuite
test))
(PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg)]))
where
cabalDir :: Path Abs Dir
cabalDir = forall b t. Path b t -> Path b Dir
parent Path Abs File
cabalfp
data BioInput = BioInput
{ BioInput -> InstallMap
biInstallMap :: !InstallMap
, BioInput -> InstalledMap
biInstalledMap :: !InstalledMap
, BioInput -> Path Abs Dir
biCabalDir :: !(Path Abs Dir)
, BioInput -> Path Abs Dir
biDistDir :: !(Path Abs Dir)
, BioInput -> [PackageName]
biOmitPackages :: ![PackageName]
, BioInput -> [PackageName]
biAddPackages :: ![PackageName]
, BioInput -> BuildInfo
biBuildInfo :: !BuildInfo
, BioInput -> [DotCabalPath]
biDotCabalPaths :: ![DotCabalPath]
, BioInput -> [String]
biConfigLibDirs :: ![FilePath]
, BioInput -> [String]
biConfigIncludeDirs :: ![FilePath]
, BioInput -> NamedComponent
biComponentName :: !NamedComponent
, BioInput -> Version
biCabalVersion :: !Version
}
generateBuildInfoOpts :: BioInput -> BuildInfoOpts
generateBuildInfoOpts :: BioInput -> BuildInfoOpts
generateBuildInfoOpts BioInput {[String]
[PackageName]
[DotCabalPath]
BuildInfo
Version
InstallMap
InstalledMap
Path Abs Dir
NamedComponent
biCabalVersion :: Version
biComponentName :: NamedComponent
biConfigIncludeDirs :: [String]
biConfigLibDirs :: [String]
biDotCabalPaths :: [DotCabalPath]
biBuildInfo :: BuildInfo
biAddPackages :: [PackageName]
biOmitPackages :: [PackageName]
biDistDir :: Path Abs Dir
biCabalDir :: Path Abs Dir
biInstalledMap :: InstalledMap
biInstallMap :: InstallMap
biCabalVersion :: BioInput -> Version
biComponentName :: BioInput -> NamedComponent
biConfigIncludeDirs :: BioInput -> [String]
biConfigLibDirs :: BioInput -> [String]
biDotCabalPaths :: BioInput -> [DotCabalPath]
biBuildInfo :: BioInput -> BuildInfo
biAddPackages :: BioInput -> [PackageName]
biOmitPackages :: BioInput -> [PackageName]
biDistDir :: BioInput -> Path Abs Dir
biCabalDir :: BioInput -> Path Abs Dir
biInstalledMap :: BioInput -> InstalledMap
biInstallMap :: BioInput -> InstallMap
..} =
BuildInfoOpts
{ bioOpts :: [String]
bioOpts = [String]
ghcOpts forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"-optP" forall a. Semigroup a => a -> a -> a
<>) (BuildInfo -> [String]
cppOptions BuildInfo
biBuildInfo)
, bioOneWordOpts :: [String]
bioOneWordOpts = forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[[String]
extOpts, [String]
srcOpts, [String]
includeOpts, [String]
libOpts, [String]
fworks, [String]
cObjectFiles]
, bioPackageFlags :: [String]
bioPackageFlags = [String]
deps
, bioCabalMacros :: Path Abs File
bioCabalMacros = Path Abs Dir
componentAutogen forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileCabalMacrosH
}
where
cObjectFiles :: [String]
cObjectFiles =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b t. Path b t -> String
toFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir
-> NamedComponent
-> Path Abs Dir
-> Path Abs File
-> m (Path Abs File)
makeObjectFilePathFromC Path Abs Dir
biCabalDir NamedComponent
biComponentName Path Abs Dir
biDistDir)
[Path Abs File]
cfiles
cfiles :: [Path Abs File]
cfiles = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DotCabalPath -> Maybe (Path Abs File)
dotCabalCFilePath [DotCabalPath]
biDotCabalPaths
installVersion :: (a, b) -> b
installVersion = forall a b. (a, b) -> b
snd
deps :: [String]
deps =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackageName
name InstalledMap
biInstalledMap of
Just (InstallLocation
_, Stack.Types.Package.Library PackageIdentifier
_ident GhcPkgId
ipid Maybe (Either License License)
_) -> [String
"-package-id=" forall a. Semigroup a => a -> a -> a
<> GhcPkgId -> String
ghcPkgIdString GhcPkgId
ipid]
Maybe (InstallLocation, Installed)
_ -> [String
"-package=" forall a. Semigroup a => a -> a -> a
<> PackageName -> String
packageNameString PackageName
name forall a. Semigroup a => a -> a -> a
<>
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
""
(((String
"-" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
versionString) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
installVersion)
(forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackageName
name InstallMap
biInstallMap)]
| PackageName
name <- [PackageName]
pkgs]
pkgs :: [PackageName]
pkgs =
[PackageName]
biAddPackages forall a. [a] -> [a] -> [a]
++
[ PackageName
name
| Dependency PackageName
name VersionRange
_ NonEmptySet LibraryName
_ <- BuildInfo -> [Dependency]
targetBuildDepends BuildInfo
biBuildInfo
, PackageName
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageName]
biOmitPackages]
PerCompilerFlavor [String]
ghcOpts [String]
_ = BuildInfo -> PerCompilerFlavor [String]
options BuildInfo
biBuildInfo
extOpts :: [String]
extOpts = forall a b. (a -> b) -> [a] -> [b]
map ((String
"-X" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
display) (BuildInfo -> [Extension]
usedExtensions BuildInfo
biBuildInfo)
srcOpts :: [String]
srcOpts =
forall a b. (a -> b) -> [a] -> [b]
map ((String
"-i" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall loc. Path loc Dir -> String
toFilePathNoTrailingSep)
(forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentBuildDir Version
biCabalVersion NamedComponent
biComponentName Path Abs Dir
biDistDir ]
, [ Path Abs Dir
biCabalDir
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
biBuildInfo)
]
, forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe (Path Abs Dir)
toIncludeDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. SymbolicPath from to -> String
getSymbolicPath) (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
biBuildInfo)
, [ Path Abs Dir
componentAutogen ]
, forall a. Maybe a -> [a]
maybeToList (Version -> Path Abs Dir -> Maybe (Path Abs Dir)
packageAutogenDir Version
biCabalVersion Path Abs Dir
biDistDir)
, [ NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir NamedComponent
biComponentName Path Abs Dir
biDistDir ]
]) forall a. [a] -> [a] -> [a]
++
[ String
"-stubdir=" forall a. [a] -> [a] -> [a]
++ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep (Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
biDistDir) ]
componentAutogen :: Path Abs Dir
componentAutogen = Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentAutogenDir Version
biCabalVersion NamedComponent
biComponentName Path Abs Dir
biDistDir
toIncludeDir :: String -> Maybe (Path Abs Dir)
toIncludeDir String
"." = forall a. a -> Maybe a
Just Path Abs Dir
biCabalDir
toIncludeDir String
relDir = forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir -> String -> m (Path Abs Dir)
concatAndCollapseAbsDir Path Abs Dir
biCabalDir String
relDir
includeOpts :: [String]
includeOpts =
forall a b. (a -> b) -> [a] -> [b]
map (String
"-I" forall a. Semigroup a => a -> a -> a
<>) ([String]
biConfigIncludeDirs forall a. Semigroup a => a -> a -> a
<> [String]
pkgIncludeOpts)
pkgIncludeOpts :: [String]
pkgIncludeOpts =
[ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
absDir
| String
dir <- BuildInfo -> [String]
includeDirs BuildInfo
biBuildInfo
, Path Abs Dir
absDir <- String -> [Path Abs Dir]
handleDir String
dir
]
libOpts :: [String]
libOpts =
forall a b. (a -> b) -> [a] -> [b]
map (String
"-l" forall a. Semigroup a => a -> a -> a
<>) (BuildInfo -> [String]
extraLibs BuildInfo
biBuildInfo) forall a. Semigroup a => a -> a -> a
<>
forall a b. (a -> b) -> [a] -> [b]
map (String
"-L" forall a. Semigroup a => a -> a -> a
<>) ([String]
biConfigLibDirs forall a. Semigroup a => a -> a -> a
<> [String]
pkgLibDirs)
pkgLibDirs :: [String]
pkgLibDirs =
[ forall loc. Path loc Dir -> String
toFilePathNoTrailingSep Path Abs Dir
absDir
| String
dir <- BuildInfo -> [String]
extraLibDirs BuildInfo
biBuildInfo
, Path Abs Dir
absDir <- String -> [Path Abs Dir]
handleDir String
dir
]
handleDir :: String -> [Path Abs Dir]
handleDir String
dir = case (forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir String
dir, forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir String
dir) of
(Just Path Abs Dir
ab, Maybe (Path Rel Dir)
_ ) -> [Path Abs Dir
ab]
(Maybe (Path Abs Dir)
_ , Just Path Rel Dir
rel) -> [Path Abs Dir
biCabalDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
rel]
(Maybe (Path Abs Dir)
Nothing, Maybe (Path Rel Dir)
Nothing ) -> []
fworks :: [String]
fworks = forall a b. (a -> b) -> [a] -> [b]
map (\String
fwk -> String
"-framework=" forall a. Semigroup a => a -> a -> a
<> String
fwk) (BuildInfo -> [String]
frameworks BuildInfo
biBuildInfo)
makeObjectFilePathFromC
:: MonadThrow m
=> Path Abs Dir
-> NamedComponent
-> Path Abs Dir
-> Path Abs File
-> m (Path Abs File)
makeObjectFilePathFromC :: forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir
-> NamedComponent
-> Path Abs Dir
-> Path Abs File
-> m (Path Abs File)
makeObjectFilePathFromC Path Abs Dir
cabalDir NamedComponent
namedComponent Path Abs Dir
distDir Path Abs File
cFilePath = do
Path Rel File
relCFilePath <- forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix Path Abs Dir
cabalDir Path Abs File
cFilePath
Path Rel File
relOFilePath <-
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (String -> String -> String
replaceExtension (forall b t. Path b t -> String
toFilePath Path Rel File
relCFilePath) String
"o")
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir NamedComponent
namedComponent Path Abs Dir
distDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relOFilePath)
packageDependencies
:: PackageConfig
-> PackageDescription
-> Map PackageName VersionRange
packageDependencies :: PackageConfig -> PackageDescription -> Map PackageName VersionRange
packageDependencies PackageConfig
pkgConfig PackageDescription
pkg' =
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith VersionRange -> VersionRange -> VersionRange
intersectVersionRanges forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (Dependency -> PackageName
depPkgName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Dependency -> VersionRange
depVerRange) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [Dependency]
targetBuildDepends (PackageDescription -> [BuildInfo]
allBuildInfo' PackageDescription
pkg) forall a. [a] -> [a] -> [a]
++
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] SetupBuildInfo -> [Dependency]
setupDepends (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg)
where
pkg :: PackageDescription
pkg
| ActualCompiler -> Version
getGhcVersion (PackageConfig -> ActualCompiler
packageConfigCompilerVersion PackageConfig
pkgConfig) forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8, Int
0] = PackageDescription
pkg'
| Bool
otherwise = PackageDescription
pkg'
{ library :: Maybe Library
library = (\Library
c -> Library
c { libBuildInfo :: BuildInfo
libBuildInfo = BuildInfo -> BuildInfo
go (Library -> BuildInfo
libBuildInfo Library
c) }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> Maybe Library
library PackageDescription
pkg'
, executables :: [Executable]
executables = (\Executable
c -> Executable
c { buildInfo :: BuildInfo
buildInfo = BuildInfo -> BuildInfo
go (Executable -> BuildInfo
buildInfo Executable
c) }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [Executable]
executables PackageDescription
pkg'
, testSuites :: [TestSuite]
testSuites =
if PackageConfig -> Bool
packageConfigEnableTests PackageConfig
pkgConfig
then (\TestSuite
c -> TestSuite
c { testBuildInfo :: BuildInfo
testBuildInfo = BuildInfo -> BuildInfo
go (TestSuite -> BuildInfo
testBuildInfo TestSuite
c) }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg'
else PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg'
, benchmarks :: [Benchmark]
benchmarks =
if PackageConfig -> Bool
packageConfigEnableBenchmarks PackageConfig
pkgConfig
then (\Benchmark
c -> Benchmark
c { benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BuildInfo -> BuildInfo
go (Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
c) }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg'
else PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg'
}
go :: BuildInfo -> BuildInfo
go BuildInfo
bi = BuildInfo
bi { buildable :: Bool
buildable = Bool
True }
packageDescTools
:: PackageDescription
-> (Set ExeName, Map PackageName DepValue)
packageDescTools :: PackageDescription -> (Set ExeName, Map PackageName DepValue)
packageDescTools PackageDescription
pd =
(forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ExeName]]
unknowns, forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(PackageName, DepValue)]]
knowns)
where
([[ExeName]]
unknowns, [[(PackageName, DepValue)]]
knowns) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map BuildInfo -> ([ExeName], [(PackageName, DepValue)])
perBI forall a b. (a -> b) -> a -> b
$ PackageDescription -> [BuildInfo]
allBuildInfo' PackageDescription
pd
perBI :: BuildInfo -> ([ExeName], [(PackageName, DepValue)])
perBI :: BuildInfo -> ([ExeName], [(PackageName, DepValue)])
perBI BuildInfo
bi =
([ExeName]
unknownTools, [(PackageName, DepValue)]
tools)
where
([ExeName]
unknownTools, [ExeDependency]
knownTools) = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LegacyExeDependency -> Either ExeName ExeDependency
go1 (BuildInfo -> [LegacyExeDependency]
buildTools BuildInfo
bi)
tools :: [(PackageName, DepValue)]
tools = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ExeDependency -> Maybe (PackageName, DepValue)
go2 ([ExeDependency]
knownTools forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ExeDependency]
buildToolDepends BuildInfo
bi)
go1 :: Cabal.LegacyExeDependency -> Either ExeName Cabal.ExeDependency
go1 :: LegacyExeDependency -> Either ExeName ExeDependency
go1 (Cabal.LegacyExeDependency String
name VersionRange
range) =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name Map String PackageName
hardCodedMap of
Just PackageName
pkgName -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ PackageName -> UnqualComponentName -> VersionRange -> ExeDependency
Cabal.ExeDependency PackageName
pkgName (String -> UnqualComponentName
Cabal.mkUnqualComponentName String
name) VersionRange
range
Maybe PackageName
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> ExeName
ExeName forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
name
go2 :: Cabal.ExeDependency -> Maybe (PackageName, DepValue)
go2 :: ExeDependency -> Maybe (PackageName, DepValue)
go2 (Cabal.ExeDependency PackageName
pkg UnqualComponentName
_name VersionRange
range)
| PackageName
pkg forall a. Ord a => a -> Set a -> Bool
`S.member` Set PackageName
preInstalledPackages = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just
( PackageName
pkg
, DepValue
{ dvVersionRange :: VersionRange
dvVersionRange = VersionRange
range
, dvType :: DepType
dvType = DepType
AsBuildTool
}
)
hardCodedMap :: Map String PackageName
hardCodedMap :: Map String PackageName
hardCodedMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (String
"alex", String -> PackageName
Distribution.Package.mkPackageName String
"alex")
, (String
"happy", String -> PackageName
Distribution.Package.mkPackageName String
"happy")
, (String
"cpphs", String -> PackageName
Distribution.Package.mkPackageName String
"cpphs")
, (String
"greencard", String -> PackageName
Distribution.Package.mkPackageName String
"greencard")
, (String
"c2hs", String -> PackageName
Distribution.Package.mkPackageName String
"c2hs")
, (String
"hscolour", String -> PackageName
Distribution.Package.mkPackageName String
"hscolour")
, (String
"hspec-discover", String -> PackageName
Distribution.Package.mkPackageName String
"hspec-discover")
, (String
"hsx2hs", String -> PackageName
Distribution.Package.mkPackageName String
"hsx2hs")
, (String
"gtk2hsC2hs", String -> PackageName
Distribution.Package.mkPackageName String
"gtk2hs-buildtools")
, (String
"gtk2hsHookGenerator", String -> PackageName
Distribution.Package.mkPackageName String
"gtk2hs-buildtools")
, (String
"gtk2hsTypeGen", String -> PackageName
Distribution.Package.mkPackageName String
"gtk2hs-buildtools")
]
preInstalledPackages :: Set PackageName
preInstalledPackages :: Set PackageName
preInstalledPackages = forall a. Ord a => [a] -> Set a
S.fromList
[ String -> PackageName
mkPackageName String
"hsc2hs"
, String -> PackageName
mkPackageName String
"haddock"
]
allBuildInfo' :: PackageDescription -> [BuildInfo]
allBuildInfo' :: PackageDescription -> [BuildInfo]
allBuildInfo' PackageDescription
pkg_descr = [ BuildInfo
bi | Library
lib <- PackageDescription -> [Library]
allLibraries PackageDescription
pkg_descr
, let bi :: BuildInfo
bi = Library -> BuildInfo
libBuildInfo Library
lib
, BuildInfo -> Bool
buildable BuildInfo
bi ]
forall a. [a] -> [a] -> [a]
++ [ BuildInfo
bi | ForeignLib
flib <- PackageDescription -> [ForeignLib]
foreignLibs PackageDescription
pkg_descr
, let bi :: BuildInfo
bi = ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
flib
, BuildInfo -> Bool
buildable BuildInfo
bi ]
forall a. [a] -> [a] -> [a]
++ [ BuildInfo
bi | Executable
exe <- PackageDescription -> [Executable]
executables PackageDescription
pkg_descr
, let bi :: BuildInfo
bi = Executable -> BuildInfo
buildInfo Executable
exe
, BuildInfo -> Bool
buildable BuildInfo
bi ]
forall a. [a] -> [a] -> [a]
++ [ BuildInfo
bi | TestSuite
tst <- PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg_descr
, let bi :: BuildInfo
bi = TestSuite -> BuildInfo
testBuildInfo TestSuite
tst
, BuildInfo -> Bool
buildable BuildInfo
bi ]
forall a. [a] -> [a] -> [a]
++ [ BuildInfo
bi | Benchmark
tst <- PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg_descr
, let bi :: BuildInfo
bi = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
tst
, BuildInfo -> Bool
buildable BuildInfo
bi ]
data PackageDescriptionPair = PackageDescriptionPair
{ PackageDescriptionPair -> PackageDescription
pdpOrigBuildable :: PackageDescription
, PackageDescriptionPair -> PackageDescription
pdpModifiedBuildable :: PackageDescription
}
resolvePackageDescription :: PackageConfig
-> GenericPackageDescription
-> PackageDescriptionPair
resolvePackageDescription :: PackageConfig
-> GenericPackageDescription -> PackageDescriptionPair
resolvePackageDescription PackageConfig
packageConfig (GenericPackageDescription PackageDescription
desc Maybe Version
_ [PackageFlag]
defaultFlags Maybe (CondTree ConfVar [Dependency] Library)
mlib [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
subLibs [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
foreignLibs' [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benches) =
PackageDescriptionPair
{ pdpOrigBuildable :: PackageDescription
pdpOrigBuildable = Bool -> PackageDescription
go Bool
False
, pdpModifiedBuildable :: PackageDescription
pdpModifiedBuildable = Bool -> PackageDescription
go Bool
True
}
where
go :: Bool -> PackageDescription
go Bool
modBuildable =
PackageDescription
desc {library :: Maybe Library
library =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc Library -> [Dependency] -> Library
updateLibDeps) Maybe (CondTree ConfVar [Dependency] Library)
mlib
,subLibraries :: [Library]
subLibraries =
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n, CondTree ConfVar [Dependency] Library
v) -> (forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc Library -> [Dependency] -> Library
updateLibDeps CondTree ConfVar [Dependency] Library
v){libName :: LibraryName
libName=UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
n})
[(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
subLibs
,foreignLibs :: [ForeignLib]
foreignLibs =
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n, CondTree ConfVar [Dependency] ForeignLib
v) -> (forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc ForeignLib -> [Dependency] -> ForeignLib
updateForeignLibDeps CondTree ConfVar [Dependency] ForeignLib
v){foreignLibName :: UnqualComponentName
foreignLibName=UnqualComponentName
n})
[(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
foreignLibs'
,executables :: [Executable]
executables =
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n, CondTree ConfVar [Dependency] Executable
v) -> (forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc Executable -> [Dependency] -> Executable
updateExeDeps CondTree ConfVar [Dependency] Executable
v){exeName :: UnqualComponentName
exeName=UnqualComponentName
n})
[(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes
,testSuites :: [TestSuite]
testSuites =
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n,CondTree ConfVar [Dependency] TestSuite
v) -> (forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc (Bool -> TestSuite -> [Dependency] -> TestSuite
updateTestDeps Bool
modBuildable) CondTree ConfVar [Dependency] TestSuite
v){testName :: UnqualComponentName
testName=UnqualComponentName
n})
[(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests
,benchmarks :: [Benchmark]
benchmarks =
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n,CondTree ConfVar [Dependency] Benchmark
v) -> (forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc (Bool -> Benchmark -> [Dependency] -> Benchmark
updateBenchmarkDeps Bool
modBuildable) CondTree ConfVar [Dependency] Benchmark
v){benchmarkName :: UnqualComponentName
benchmarkName=UnqualComponentName
n})
[(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benches}
flags :: Map FlagName Bool
flags =
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (PackageConfig -> Map FlagName Bool
packageConfigFlags PackageConfig
packageConfig)
([PackageFlag] -> Map FlagName Bool
flagMap [PackageFlag]
defaultFlags)
rc :: ResolveConditions
rc = ActualCompiler
-> Platform -> Map FlagName Bool -> ResolveConditions
mkResolveConditions
(PackageConfig -> ActualCompiler
packageConfigCompilerVersion PackageConfig
packageConfig)
(PackageConfig -> Platform
packageConfigPlatform PackageConfig
packageConfig)
Map FlagName Bool
flags
updateLibDeps :: Library -> [Dependency] -> Library
updateLibDeps Library
lib [Dependency]
deps =
Library
lib {libBuildInfo :: BuildInfo
libBuildInfo =
(Library -> BuildInfo
libBuildInfo Library
lib) {targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps}}
updateForeignLibDeps :: ForeignLib -> [Dependency] -> ForeignLib
updateForeignLibDeps ForeignLib
lib [Dependency]
deps =
ForeignLib
lib {foreignLibBuildInfo :: BuildInfo
foreignLibBuildInfo =
(ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
lib) {targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps}}
updateExeDeps :: Executable -> [Dependency] -> Executable
updateExeDeps Executable
exe [Dependency]
deps =
Executable
exe {buildInfo :: BuildInfo
buildInfo =
(Executable -> BuildInfo
buildInfo Executable
exe) {targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps}}
updateTestDeps :: Bool -> TestSuite -> [Dependency] -> TestSuite
updateTestDeps Bool
modBuildable TestSuite
test [Dependency]
deps =
let bi :: BuildInfo
bi = TestSuite -> BuildInfo
testBuildInfo TestSuite
test
bi' :: BuildInfo
bi' = BuildInfo
bi
{ targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps
, buildable :: Bool
buildable = BuildInfo -> Bool
buildable BuildInfo
bi Bool -> Bool -> Bool
&& (if Bool
modBuildable then PackageConfig -> Bool
packageConfigEnableTests PackageConfig
packageConfig else Bool
True)
}
in TestSuite
test { testBuildInfo :: BuildInfo
testBuildInfo = BuildInfo
bi' }
updateBenchmarkDeps :: Bool -> Benchmark -> [Dependency] -> Benchmark
updateBenchmarkDeps Bool
modBuildable Benchmark
benchmark [Dependency]
deps =
let bi :: BuildInfo
bi = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
benchmark
bi' :: BuildInfo
bi' = BuildInfo
bi
{ targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps
, buildable :: Bool
buildable = BuildInfo -> Bool
buildable BuildInfo
bi Bool -> Bool -> Bool
&& (if Bool
modBuildable then PackageConfig -> Bool
packageConfigEnableBenchmarks PackageConfig
packageConfig else Bool
True)
}
in Benchmark
benchmark { benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BuildInfo
bi' }
flagMap :: [PackageFlag] -> Map FlagName Bool
flagMap :: [PackageFlag] -> Map FlagName Bool
flagMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map PackageFlag -> (FlagName, Bool)
pair
where pair :: PackageFlag -> (FlagName, Bool)
pair :: PackageFlag -> (FlagName, Bool)
pair = PackageFlag -> FlagName
flagName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PackageFlag -> Bool
flagDefault
data ResolveConditions = ResolveConditions
{ ResolveConditions -> Map FlagName Bool
rcFlags :: Map FlagName Bool
, ResolveConditions -> ActualCompiler
rcCompilerVersion :: ActualCompiler
, ResolveConditions -> OS
rcOS :: OS
, ResolveConditions -> Arch
rcArch :: Arch
}
mkResolveConditions :: ActualCompiler
-> Platform
-> Map FlagName Bool
-> ResolveConditions
mkResolveConditions :: ActualCompiler
-> Platform -> Map FlagName Bool -> ResolveConditions
mkResolveConditions ActualCompiler
compilerVersion (Platform Arch
arch OS
os) Map FlagName Bool
flags = ResolveConditions
{ rcFlags :: Map FlagName Bool
rcFlags = Map FlagName Bool
flags
, rcCompilerVersion :: ActualCompiler
rcCompilerVersion = ActualCompiler
compilerVersion
, rcOS :: OS
rcOS = OS
os
, rcArch :: Arch
rcArch = Arch
arch
}
resolveConditions :: (Semigroup target,Monoid target,Show target)
=> ResolveConditions
-> (target -> cs -> target)
-> CondTree ConfVar cs target
-> target
resolveConditions :: forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc target -> cs -> target
addDeps (CondNode target
lib cs
deps [CondBranch ConfVar cs target]
cs) = target
basic forall a. Semigroup a => a -> a -> a
<> target
children
where basic :: target
basic = target -> cs -> target
addDeps target
lib cs
deps
children :: target
children = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map CondBranch ConfVar cs target -> target
apply [CondBranch ConfVar cs target]
cs)
where apply :: CondBranch ConfVar cs target -> target
apply (Cabal.CondBranch Condition ConfVar
cond CondTree ConfVar cs target
node Maybe (CondTree ConfVar cs target)
mcs) =
if Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cond
then forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc target -> cs -> target
addDeps CondTree ConfVar cs target
node
else forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc target -> cs -> target
addDeps) Maybe (CondTree ConfVar cs target)
mcs
condSatisfied :: Condition ConfVar -> Bool
condSatisfied Condition ConfVar
c =
case Condition ConfVar
c of
Var ConfVar
v -> ConfVar -> Bool
varSatisfied ConfVar
v
Lit Bool
b -> Bool
b
CNot Condition ConfVar
c' ->
Bool -> Bool
not (Condition ConfVar -> Bool
condSatisfied Condition ConfVar
c')
COr Condition ConfVar
cx Condition ConfVar
cy ->
Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cx Bool -> Bool -> Bool
|| Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cy
CAnd Condition ConfVar
cx Condition ConfVar
cy ->
Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cx Bool -> Bool -> Bool
&& Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cy
varSatisfied :: ConfVar -> Bool
varSatisfied ConfVar
v =
case ConfVar
v of
OS OS
os -> OS
os forall a. Eq a => a -> a -> Bool
== ResolveConditions -> OS
rcOS ResolveConditions
rc
Arch Arch
arch -> Arch
arch forall a. Eq a => a -> a -> Bool
== ResolveConditions -> Arch
rcArch ResolveConditions
rc
PackageFlag FlagName
flag ->
forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FlagName
flag (ResolveConditions -> Map FlagName Bool
rcFlags ResolveConditions
rc)
Impl CompilerFlavor
flavor VersionRange
range ->
case (CompilerFlavor
flavor, ResolveConditions -> ActualCompiler
rcCompilerVersion ResolveConditions
rc) of
(CompilerFlavor
GHC, ACGhc Version
vghc) -> Version
vghc Version -> VersionRange -> Bool
`withinRange` VersionRange
range
(CompilerFlavor, ActualCompiler)
_ -> Bool
False
buildLogPath :: (MonadReader env m, HasBuildConfig env, MonadThrow m)
=> Package -> Maybe String -> m (Path Abs File)
buildLogPath :: forall env (m :: * -> *).
(MonadReader env m, HasBuildConfig env, MonadThrow m) =>
Package -> Maybe String -> m (Path Abs File)
buildLogPath Package
package' Maybe String
msuffix = do
env
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
let stack :: Path Abs Dir
stack = forall env (m :: * -> *).
(HasBuildConfig env, MonadReader env m) =>
m (Path Abs Dir)
getProjectWorkDir env
env
Path Rel File
fp <- forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
PackageIdentifier -> String
packageIdentifierString (Package -> PackageIdentifier
packageIdentifier Package
package') forall a. a -> [a] -> [a]
:
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\String
suffix -> (String
"-" forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
suffix forall a. a -> [a] -> [a]
:)) Maybe String
msuffix [String
".log"]
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Path Abs Dir
stack forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirLogs forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
fp
applyForceCustomBuild
:: Version
-> Package
-> Package
applyForceCustomBuild :: Version -> Package -> Package
applyForceCustomBuild Version
cabalVersion Package
package
| Bool
forceCustomBuild =
Package
package
{ packageBuildType :: BuildType
packageBuildType = BuildType
Custom
, packageDeps :: Map PackageName DepValue
packageDeps = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Semigroup a => a -> a -> a
(<>) PackageName
"Cabal" (VersionRange -> DepType -> DepValue
DepValue VersionRange
cabalVersionRange DepType
AsLibrary)
forall a b. (a -> b) -> a -> b
$ Package -> Map PackageName DepValue
packageDeps Package
package
, packageSetupDeps :: Maybe (Map PackageName VersionRange)
packageSetupDeps = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (PackageName
"Cabal", VersionRange
cabalVersionRange)
, (PackageName
"base", VersionRange
anyVersion)
]
}
| Bool
otherwise = Package
package
where
cabalVersionRange :: VersionRange
cabalVersionRange =
Version -> VersionRange
orLaterVersion forall a b. (a -> b) -> a -> b
$ [Int] -> Version
mkVersion forall a b. (a -> b) -> a -> b
$ CabalSpecVersion -> [Int]
cabalSpecToVersionDigits forall a b. (a -> b) -> a -> b
$
Package -> CabalSpecVersion
packageCabalSpec Package
package
forceCustomBuild :: Bool
forceCustomBuild =
Package -> BuildType
packageBuildType Package
package forall a. Eq a => a -> a -> Bool
== BuildType
Simple Bool -> Bool -> Bool
&&
Bool -> Bool
not (Version
cabalVersion Version -> VersionRange -> Bool
`withinRange` VersionRange
cabalVersionRange)