{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Stack.Package
(readDotBuildinfo
,resolvePackage
,packageFromPackageDescription
,Package(..)
,PackageDescriptionPair(..)
,GetPackageFiles(..)
,GetPackageOpts(..)
,PackageConfig(..)
,buildLogPath
,PackageException (..)
,resolvePackageDescription
,packageDependencies
,applyForceCustomBuild
) where
import Data.List (find, isPrefixOf, 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.ModuleName (ModuleName)
import qualified Distribution.ModuleName as Cabal
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)
import Distribution.Simple.Glob (matchDirFileGlob)
#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 qualified HiFileParser as Iface
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 qualified System.Directory as D (doesFileExist)
import System.FilePath (replaceExtension)
import qualified System.FilePath as FilePath
import System.IO.Error
import RIO.Process
import RIO.PrettyPrint
import qualified RIO.PrettyPrint as PP (Style (Module))
data Ctx = Ctx { Ctx -> Path Abs File
ctxFile :: !(Path Abs File)
, Ctx -> Path Abs Dir
ctxDistDir :: !(Path Abs Dir)
, Ctx -> BuildConfig
ctxBuildConfig :: !BuildConfig
, Ctx -> Version
ctxCabalVer :: !Version
}
instance HasPlatform Ctx
instance HasGHCVariant Ctx
instance HasLogFunc Ctx where
logFuncL :: Lens' Ctx LogFunc
logFuncL = forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasLogFunc env => Lens' env LogFunc
logFuncL
instance HasRunner Ctx where
runnerL :: Lens' Ctx Runner
runnerL = forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasRunner env => Lens' env Runner
runnerL
instance HasStylesUpdate Ctx where
stylesUpdateL :: Lens' Ctx StylesUpdate
stylesUpdateL = forall env. HasRunner env => Lens' env Runner
runnerLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasStylesUpdate env => Lens' env StylesUpdate
stylesUpdateL
instance HasTerm Ctx where
useColorL :: Lens' Ctx Bool
useColorL = forall env. HasRunner env => Lens' env Runner
runnerLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasTerm env => Lens' env Bool
useColorL
termWidthL :: Lens' Ctx Int
termWidthL = forall env. HasRunner env => Lens' env Runner
runnerLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasTerm env => Lens' env Int
termWidthL
instance HasConfig Ctx
instance HasPantryConfig Ctx where
pantryConfigL :: Lens' Ctx PantryConfig
pantryConfigL = forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasPantryConfig env => Lens' env PantryConfig
pantryConfigL
instance HasProcessContext Ctx where
processContextL :: Lens' Ctx ProcessContext
processContextL = forall env. HasConfig env => Lens' env Config
configLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
instance HasBuildConfig Ctx where
buildConfigL :: Lens' Ctx BuildConfig
buildConfigL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Ctx -> BuildConfig
ctxBuildConfig (\Ctx
x BuildConfig
y -> Ctx
x { ctxBuildConfig :: BuildConfig
ctxBuildConfig = BuildConfig
y })
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 a. Ord a => [a] -> Set a
S.fromList (forall k a. Map k a -> [k]
M.keys 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 (m :: * -> *) a. Monad m => a -> m a
return (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 -> Ctx
Ctx Path Abs File
cabalfp Path Abs Dir
distDir BuildConfig
bc Version
cabalVer)
(PackageDescription
-> RIO
Ctx
(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 (m :: * -> *) a. Monad m => a -> m a
return (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 (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Set a
S.singleton Path Abs File
setupLhsPath) else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Set a
S.empty
else forall (m :: * -> *) a. Monad m => a -> m a
return 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 (m :: * -> *) a. Monad m => a -> m a
return 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 (m :: * -> *) a. Monad m => a -> m a
return (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 (m :: * -> *) a. Monad m => a -> m a
return
( 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 (m :: * -> *) a. Monad m => a -> m a
return 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]
InstallMap
InstalledMap
Version
Path Abs Dir
BuildInfo
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 (m :: * -> *) a. Monad m => a -> m a
return (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)
packageAutogenDir :: Version -> Path Abs Dir -> Maybe (Path Abs Dir)
packageAutogenDir :: Version -> Path Abs Dir -> Maybe (Path Abs Dir)
packageAutogenDir Version
cabalVer Path Abs Dir
distDir
| Version
cabalVer forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
2, Int
0] = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirGlobalAutogen
componentAutogenDir :: Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentAutogenDir :: Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentAutogenDir Version
cabalVer NamedComponent
component Path Abs Dir
distDir =
Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentBuildDir Version
cabalVer NamedComponent
component Path Abs Dir
distDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirAutogen
componentBuildDir :: Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentBuildDir :: Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentBuildDir Version
cabalVer NamedComponent
component Path Abs Dir
distDir
| Version
cabalVer forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
2, Int
0] = Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir
| Bool
otherwise =
case NamedComponent
component of
NamedComponent
CLib -> Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir
CInternalLib Text
name -> Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Text -> Path Rel Dir
componentNameToDir Text
name
CExe Text
name -> Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Text -> Path Rel Dir
componentNameToDir Text
name
CTest Text
name -> Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Text -> Path Rel Dir
componentNameToDir Text
name
CBench Text
name -> Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Text -> Path Rel Dir
componentNameToDir Text
name
componentOutputDir :: NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir :: NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir NamedComponent
namedComponent Path Abs Dir
distDir =
case NamedComponent
namedComponent of
NamedComponent
CLib -> Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir
CInternalLib Text
name -> Text -> Path Abs Dir
makeTmp Text
name
CExe Text
name -> Text -> Path Abs Dir
makeTmp Text
name
CTest Text
name -> Text -> Path Abs Dir
makeTmp Text
name
CBench Text
name -> Text -> Path Abs Dir
makeTmp Text
name
where
makeTmp :: Text -> Path Abs Dir
makeTmp Text
name =
Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Text -> Path Rel Dir
componentNameToDir (Text
name forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"-tmp")
buildDir :: Path Abs Dir -> Path Abs Dir
buildDir :: Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir = Path Abs Dir
distDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBuild
componentNameToDir :: Text -> Path Rel Dir
componentNameToDir :: Text -> Path Rel Dir
componentNameToDir Text
name =
forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"Invariant violated: component names should always parse as directory names")
(forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir (Text -> String
T.unpack Text
name))
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 ]
packageDescModulesAndFiles
:: PackageDescription
-> RIO Ctx (Map NamedComponent (Map ModuleName (Path Abs File)), Map NamedComponent [DotCabalPath], Set (Path Abs File), [PackageWarning])
packageDescModulesAndFiles :: PackageDescription
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
packageDescModulesAndFiles PackageDescription
pkg = do
(Map NamedComponent (Map ModuleName (Path Abs File))
libraryMods,Map NamedComponent [DotCabalPath]
libDotCabalFiles,[PackageWarning]
libWarnings) <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Map k a
M.empty, forall k a. Map k a
M.empty, []))
(forall {m :: * -> *} {t} {k} {a} {a} {c}.
Monad m =>
(t -> k) -> (k -> t -> m (a, a, c)) -> t -> m (Map k a, Map k a, c)
asModuleAndFileMap forall {b}. b -> NamedComponent
libComponent NamedComponent
-> Library
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
libraryFiles)
(PackageDescription -> Maybe Library
library PackageDescription
pkg)
(Map NamedComponent (Map ModuleName (Path Abs File))
subLibrariesMods,Map NamedComponent [DotCabalPath]
subLibDotCabalFiles,[PackageWarning]
subLibWarnings) <-
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
forall {a} {a} {a}.
[(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
foldTuples
(forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
(forall {m :: * -> *} {t} {k} {a} {a} {c}.
Monad m =>
(t -> k) -> (k -> t -> m (a, a, c)) -> t -> m (Map k a, Map k a, c)
asModuleAndFileMap Library -> NamedComponent
internalLibComponent NamedComponent
-> Library
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
libraryFiles)
(PackageDescription -> [Library]
subLibraries PackageDescription
pkg))
(Map NamedComponent (Map ModuleName (Path Abs File))
executableMods,Map NamedComponent [DotCabalPath]
exeDotCabalFiles,[PackageWarning]
exeWarnings) <-
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
forall {a} {a} {a}.
[(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
foldTuples
(forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
(forall {m :: * -> *} {t} {k} {a} {a} {c}.
Monad m =>
(t -> k) -> (k -> t -> m (a, a, c)) -> t -> m (Map k a, Map k a, c)
asModuleAndFileMap Executable -> NamedComponent
exeComponent NamedComponent
-> Executable
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
executableFiles)
(PackageDescription -> [Executable]
executables PackageDescription
pkg))
(Map NamedComponent (Map ModuleName (Path Abs File))
testMods,Map NamedComponent [DotCabalPath]
testDotCabalFiles,[PackageWarning]
testWarnings) <-
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
forall {a} {a} {a}.
[(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
foldTuples
(forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *} {t} {k} {a} {a} {c}.
Monad m =>
(t -> k) -> (k -> t -> m (a, a, c)) -> t -> m (Map k a, Map k a, c)
asModuleAndFileMap TestSuite -> NamedComponent
testComponent NamedComponent
-> TestSuite
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
testFiles) (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg))
(Map NamedComponent (Map ModuleName (Path Abs File))
benchModules,Map NamedComponent [DotCabalPath]
benchDotCabalPaths,[PackageWarning]
benchWarnings) <-
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
forall {a} {a} {a}.
[(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
foldTuples
(forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
(forall {m :: * -> *} {t} {k} {a} {a} {c}.
Monad m =>
(t -> k) -> (k -> t -> m (a, a, c)) -> t -> m (Map k a, Map k a, c)
asModuleAndFileMap Benchmark -> NamedComponent
benchComponent NamedComponent
-> Benchmark
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
benchmarkFiles)
(PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg))
Set (Path Abs File)
dfiles <- CabalSpecVersion -> [String] -> RIO Ctx (Set (Path Abs File))
resolveGlobFiles (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg)
(PackageDescription -> [String]
extraSrcFiles PackageDescription
pkg
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (PackageDescription -> String
dataDir PackageDescription
pkg String -> String -> String
FilePath.</>) (PackageDescription -> [String]
dataFiles PackageDescription
pkg))
let modules :: Map NamedComponent (Map ModuleName (Path Abs File))
modules = Map NamedComponent (Map ModuleName (Path Abs File))
libraryMods forall a. Semigroup a => a -> a -> a
<> Map NamedComponent (Map ModuleName (Path Abs File))
subLibrariesMods forall a. Semigroup a => a -> a -> a
<> Map NamedComponent (Map ModuleName (Path Abs File))
executableMods forall a. Semigroup a => a -> a -> a
<> Map NamedComponent (Map ModuleName (Path Abs File))
testMods forall a. Semigroup a => a -> a -> a
<> Map NamedComponent (Map ModuleName (Path Abs File))
benchModules
files :: Map NamedComponent [DotCabalPath]
files =
Map NamedComponent [DotCabalPath]
libDotCabalFiles forall a. Semigroup a => a -> a -> a
<> Map NamedComponent [DotCabalPath]
subLibDotCabalFiles forall a. Semigroup a => a -> a -> a
<> Map NamedComponent [DotCabalPath]
exeDotCabalFiles forall a. Semigroup a => a -> a -> a
<> Map NamedComponent [DotCabalPath]
testDotCabalFiles forall a. Semigroup a => a -> a -> a
<>
Map NamedComponent [DotCabalPath]
benchDotCabalPaths
warnings :: [PackageWarning]
warnings = [PackageWarning]
libWarnings forall a. Semigroup a => a -> a -> a
<> [PackageWarning]
subLibWarnings forall a. Semigroup a => a -> a -> a
<> [PackageWarning]
exeWarnings forall a. Semigroup a => a -> a -> a
<> [PackageWarning]
testWarnings forall a. Semigroup a => a -> a -> a
<> [PackageWarning]
benchWarnings
forall (m :: * -> *) a. Monad m => a -> m a
return (Map NamedComponent (Map ModuleName (Path Abs File))
modules, Map NamedComponent [DotCabalPath]
files, Set (Path Abs File)
dfiles, [PackageWarning]
warnings)
where
libComponent :: b -> NamedComponent
libComponent = forall a b. a -> b -> a
const NamedComponent
CLib
internalLibComponent :: Library -> NamedComponent
internalLibComponent = 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
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" UnqualComponentName -> String
Cabal.unUnqualComponentName forall b c a. (b -> c) -> (a -> b) -> a -> c
. LibraryName -> Maybe UnqualComponentName
libraryNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName
exeComponent :: Executable -> NamedComponent
exeComponent = Text -> NamedComponent
CExe 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 b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> UnqualComponentName
exeName
testComponent :: TestSuite -> NamedComponent
testComponent = Text -> NamedComponent
CTest 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 b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> UnqualComponentName
testName
benchComponent :: Benchmark -> NamedComponent
benchComponent = Text -> NamedComponent
CBench 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 b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> UnqualComponentName
benchmarkName
asModuleAndFileMap :: (t -> k) -> (k -> t -> m (a, a, c)) -> t -> m (Map k a, Map k a, c)
asModuleAndFileMap t -> k
label k -> t -> m (a, a, c)
f t
lib = do
(a
a,a
b,c
c) <- k -> t -> m (a, a, c)
f (t -> k
label t
lib) t
lib
forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. k -> a -> Map k a
M.singleton (t -> k
label t
lib) a
a, forall k a. k -> a -> Map k a
M.singleton (t -> k
label t
lib) a
b, c
c)
foldTuples :: [(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
foldTuples = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Semigroup a => a -> a -> a
(<>) (forall k a. Map k a
M.empty, forall k a. Map k a
M.empty, [])
resolveGlobFiles
:: CabalSpecVersion
-> [String]
-> RIO Ctx (Set (Path Abs File))
resolveGlobFiles :: CabalSpecVersion -> [String] -> RIO Ctx (Set (Path Abs File))
resolveGlobFiles CabalSpecVersion
cabalFileVersion =
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> RIO Ctx [Maybe (Path Abs File)]
resolve
where
resolve :: String -> RIO Ctx [Maybe (Path Abs File)]
resolve String
name =
if Char
'*' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
name
then String -> RIO Ctx [Maybe (Path Abs File)]
explode String
name
else forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (m :: * -> *) a. Monad m => a -> m a
return (String -> RIO Ctx (Maybe (Path Abs File))
resolveFileOrWarn String
name)
explode :: String -> RIO Ctx [Maybe (Path Abs File)]
explode String
name = do
Path Abs Dir
dir <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall b t. Path b t -> Path b Dir
parent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
[String]
names <-
forall {m :: * -> *} {env}.
(MonadUnliftIO m, HasTerm env, MonadReader env m) =>
String -> String -> m [String]
matchDirFileGlob'
(forall b t. Path b t -> String
FL.toFilePath Path Abs Dir
dir)
String
name
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> RIO Ctx (Maybe (Path Abs File))
resolveFileOrWarn [String]
names
matchDirFileGlob' :: String -> String -> m [String]
matchDirFileGlob' String
dir String
glob =
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Verbosity -> CabalSpecVersion -> String -> String -> IO [String]
matchDirFileGlob forall a. Bounded a => a
minBound CabalSpecVersion
cabalFileVersion String
dir String
glob))
(\(IOException
e :: IOException) ->
if IOException -> Bool
isUserError IOException
e
then do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ String -> StyleDoc
flow String
"Wildcard does not match any files:"
, Style -> StyleDoc -> StyleDoc
style Style
File forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
glob
, StyleDoc
line forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
flow String
"in directory:"
, Style -> StyleDoc -> StyleDoc
style Style
Dir forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
dir
]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO IOException
e)
benchmarkFiles
:: NamedComponent
-> Benchmark
-> RIO Ctx (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
benchmarkFiles :: NamedComponent
-> Benchmark
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
benchmarkFiles NamedComponent
component Benchmark
bench = do
NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveComponentFiles NamedComponent
component BuildInfo
build [DotCabalDescriptor]
names
where
names :: [DotCabalDescriptor]
names = [DotCabalDescriptor]
bnames forall a. Semigroup a => a -> a -> a
<> [DotCabalDescriptor]
exposed
exposed :: [DotCabalDescriptor]
exposed =
case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bench of
BenchmarkExeV10 Version
_ String
fp -> [String -> DotCabalDescriptor
DotCabalMain String
fp]
BenchmarkUnsupported BenchmarkType
_ -> []
bnames :: [DotCabalDescriptor]
bnames = forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (BuildInfo -> [ModuleName]
otherModules BuildInfo
build)
build :: BuildInfo
build = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bench
testFiles
:: NamedComponent
-> TestSuite
-> RIO Ctx (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
testFiles :: NamedComponent
-> TestSuite
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
testFiles NamedComponent
component TestSuite
test = do
NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveComponentFiles NamedComponent
component BuildInfo
build [DotCabalDescriptor]
names
where
names :: [DotCabalDescriptor]
names = [DotCabalDescriptor]
bnames forall a. Semigroup a => a -> a -> a
<> [DotCabalDescriptor]
exposed
exposed :: [DotCabalDescriptor]
exposed =
case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
TestSuiteExeV10 Version
_ String
fp -> [String -> DotCabalDescriptor
DotCabalMain String
fp]
TestSuiteLibV09 Version
_ ModuleName
mn -> [ModuleName -> DotCabalDescriptor
DotCabalModule ModuleName
mn]
TestSuiteUnsupported TestType
_ -> []
bnames :: [DotCabalDescriptor]
bnames = forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (BuildInfo -> [ModuleName]
otherModules BuildInfo
build)
build :: BuildInfo
build = TestSuite -> BuildInfo
testBuildInfo TestSuite
test
executableFiles
:: NamedComponent
-> Executable
-> RIO Ctx (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
executableFiles :: NamedComponent
-> Executable
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
executableFiles NamedComponent
component Executable
exe = do
NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveComponentFiles NamedComponent
component BuildInfo
build [DotCabalDescriptor]
names
where
build :: BuildInfo
build = Executable -> BuildInfo
buildInfo Executable
exe
names :: [DotCabalDescriptor]
names =
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (BuildInfo -> [ModuleName]
otherModules BuildInfo
build) forall a. [a] -> [a] -> [a]
++
[String -> DotCabalDescriptor
DotCabalMain (Executable -> String
modulePath Executable
exe)]
libraryFiles
:: NamedComponent
-> Library
-> RIO Ctx (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
libraryFiles :: NamedComponent
-> Library
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
libraryFiles NamedComponent
component Library
lib = do
NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveComponentFiles NamedComponent
component BuildInfo
build [DotCabalDescriptor]
names
where
build :: BuildInfo
build = Library -> BuildInfo
libBuildInfo Library
lib
names :: [DotCabalDescriptor]
names = [DotCabalDescriptor]
bnames forall a. [a] -> [a] -> [a]
++ [DotCabalDescriptor]
exposed
exposed :: [DotCabalDescriptor]
exposed = forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (Library -> [ModuleName]
exposedModules Library
lib)
bnames :: [DotCabalDescriptor]
bnames = forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (BuildInfo -> [ModuleName]
otherModules BuildInfo
build)
resolveComponentFiles
:: NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO Ctx (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveComponentFiles :: NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveComponentFiles NamedComponent
component BuildInfo
build [DotCabalDescriptor]
names = do
[Path Abs Dir]
dirs <- forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (String -> RIO Ctx (Maybe (Path Abs Dir))
resolveDirOrWarn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. SymbolicPath from to -> String
getSymbolicPath) (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
build)
Path Abs Dir
dir <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall b t. Path b t -> Path b Dir
parent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
[Path Abs Dir]
agdirs <- RIO Ctx [Path Abs Dir]
autogenDirs
(Map ModuleName (Path Abs File)
modules,[DotCabalPath]
files,[PackageWarning]
warnings) <-
NamedComponent
-> [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveFilesAndDeps
NamedComponent
component
((if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path Abs Dir]
dirs then [Path Abs Dir
dir] else [Path Abs Dir]
dirs) forall a. [a] -> [a] -> [a]
++ [Path Abs Dir]
agdirs)
[DotCabalDescriptor]
names
[DotCabalPath]
cfiles <- BuildInfo -> RIO Ctx [DotCabalPath]
buildOtherSources BuildInfo
build
forall (m :: * -> *) a. Monad m => a -> m a
return (Map ModuleName (Path Abs File)
modules, [DotCabalPath]
files forall a. Semigroup a => a -> a -> a
<> [DotCabalPath]
cfiles, [PackageWarning]
warnings)
where
autogenDirs :: RIO Ctx [Path Abs Dir]
autogenDirs = do
Version
cabalVer <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Version
ctxCabalVer
Path Abs Dir
distDir <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Path Abs Dir
ctxDistDir
let compDir :: Path Abs Dir
compDir = Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentAutogenDir Version
cabalVer NamedComponent
component Path Abs Dir
distDir
pkgDir :: [Path Abs Dir]
pkgDir = forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ Version -> Path Abs Dir -> Maybe (Path Abs Dir)
packageAutogenDir Version
cabalVer Path Abs Dir
distDir
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist forall a b. (a -> b) -> a -> b
$ Path Abs Dir
compDir forall a. a -> [a] -> [a]
: [Path Abs Dir]
pkgDir
buildOtherSources :: BuildInfo -> RIO Ctx [DotCabalPath]
buildOtherSources :: BuildInfo -> RIO Ctx [DotCabalPath]
buildOtherSources BuildInfo
build = do
Path Abs Dir
cwd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
Path Abs Dir
dir <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall b t. Path b t -> Path b Dir
parent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
Path Abs File
file <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Path Abs File
ctxFile
let resolveDirFiles :: [String] -> (Path Abs File -> b) -> RIO Ctx [b]
resolveDirFiles [String]
files Path Abs File -> b
toCabalPath =
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM [String]
files forall a b. (a -> b) -> a -> b
$ \String
fp -> do
Maybe (Path Abs File)
result <- forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> String -> m (Maybe (Path Abs File))
resolveDirFile Path Abs Dir
dir String
fp
case Maybe (Path Abs File)
result of
Maybe (Path Abs File)
Nothing -> do
Text -> Path Abs Dir -> String -> Path Abs File -> RIO Ctx ()
warnMissingFile Text
"File" Path Abs Dir
cwd String
fp Path Abs File
file
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just Path Abs File
p -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Path Abs File -> b
toCabalPath Path Abs File
p)
[DotCabalPath]
csources <- forall {b}. [String] -> (Path Abs File -> b) -> RIO Ctx [b]
resolveDirFiles (BuildInfo -> [String]
cSources BuildInfo
build) Path Abs File -> DotCabalPath
DotCabalCFilePath
[DotCabalPath]
jsources <- forall {b}. [String] -> (Path Abs File -> b) -> RIO Ctx [b]
resolveDirFiles (BuildInfo -> [String]
targetJsSources BuildInfo
build) Path Abs File -> DotCabalPath
DotCabalFilePath
forall (m :: * -> *) a. Monad m => a -> m a
return ([DotCabalPath]
csources forall a. Semigroup a => a -> a -> a
<> [DotCabalPath]
jsources)
targetJsSources :: BuildInfo -> [FilePath]
targetJsSources :: BuildInfo -> [String]
targetJsSources = BuildInfo -> [String]
jsSources
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
resolveFilesAndDeps
:: NamedComponent
-> [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO Ctx (Map ModuleName (Path Abs File),[DotCabalPath],[PackageWarning])
resolveFilesAndDeps :: NamedComponent
-> [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveFilesAndDeps NamedComponent
component [Path Abs Dir]
dirs [DotCabalDescriptor]
names0 = do
([DotCabalPath]
dotCabalPaths, Map ModuleName (Path Abs File)
foundModules, [ModuleName]
missingModules) <- [DotCabalDescriptor]
-> Set ModuleName
-> RIO
Ctx ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
loop [DotCabalDescriptor]
names0 forall a. Set a
S.empty
[PackageWarning]
warnings <- forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. [a] -> [a] -> [a]
(++) (forall {m :: * -> *} {b}.
Monad m =>
Map ModuleName b -> m [PackageWarning]
warnUnlisted Map ModuleName (Path Abs File)
foundModules) (forall {m :: * -> *} {p} {a}. Monad m => p -> m [a]
warnMissing [ModuleName]
missingModules)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map ModuleName (Path Abs File)
foundModules, [DotCabalPath]
dotCabalPaths, [PackageWarning]
warnings)
where
loop :: [DotCabalDescriptor]
-> Set ModuleName
-> RIO
Ctx ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
loop [] Set ModuleName
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall k a. Map k a
M.empty, [])
loop [DotCabalDescriptor]
names Set ModuleName
doneModules0 = do
[(DotCabalDescriptor, Maybe DotCabalPath)]
resolved <- [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO Ctx [(DotCabalDescriptor, Maybe DotCabalPath)]
resolveFiles [Path Abs Dir]
dirs [DotCabalDescriptor]
names
let foundFiles :: [DotCabalPath]
foundFiles = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a b. (a, b) -> b
snd [(DotCabalDescriptor, Maybe DotCabalPath)]
resolved
foundModules :: [(ModuleName, Path Abs File)]
foundModules = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DotCabalDescriptor, Maybe DotCabalPath)
-> Maybe (ModuleName, Path Abs File)
toResolvedModule [(DotCabalDescriptor, Maybe DotCabalPath)]
resolved
missingModules :: [ModuleName]
missingModules = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DotCabalDescriptor, Maybe DotCabalPath) -> Maybe ModuleName
toMissingModule [(DotCabalDescriptor, Maybe DotCabalPath)]
resolved
[(Set ModuleName, [Path Abs File])]
pairs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NamedComponent
-> [Path Abs Dir]
-> DotCabalPath
-> RIO Ctx (Set ModuleName, [Path Abs File])
getDependencies NamedComponent
component [Path Abs Dir]
dirs) [DotCabalPath]
foundFiles
let doneModules :: Set ModuleName
doneModules =
forall a. Ord a => Set a -> Set a -> Set a
S.union
Set ModuleName
doneModules0
(forall a. Ord a => [a] -> Set a
S.fromList (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DotCabalDescriptor -> Maybe ModuleName
dotCabalModule [DotCabalDescriptor]
names))
moduleDeps :: Set ModuleName
moduleDeps = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Set ModuleName, [Path Abs File])]
pairs)
thDepFiles :: [Path Abs File]
thDepFiles = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(Set ModuleName, [Path Abs File])]
pairs
modulesRemaining :: Set ModuleName
modulesRemaining = forall a. Ord a => Set a -> Set a -> Set a
S.difference Set ModuleName
moduleDeps Set ModuleName
doneModules
([DotCabalPath]
resolvedFiles, Map ModuleName (Path Abs File)
resolvedModules, [ModuleName]
_) <-
[DotCabalDescriptor]
-> Set ModuleName
-> RIO
Ctx ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
loop (forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (forall a. Set a -> [a]
S.toList Set ModuleName
modulesRemaining)) Set ModuleName
doneModules
forall (m :: * -> *) a. Monad m => a -> m a
return
( forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ [DotCabalPath]
foundFiles forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map Path Abs File -> DotCabalPath
DotCabalFilePath [Path Abs File]
thDepFiles forall a. Semigroup a => a -> a -> a
<> [DotCabalPath]
resolvedFiles
, forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union
(forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(ModuleName, Path Abs File)]
foundModules)
Map ModuleName (Path Abs File)
resolvedModules
, [ModuleName]
missingModules)
warnUnlisted :: Map ModuleName b -> m [PackageWarning]
warnUnlisted Map ModuleName b
foundModules = do
let unlistedModules :: Map ModuleName b
unlistedModules =
Map ModuleName b
foundModules forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference`
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCabalDescriptor -> Maybe ModuleName
dotCabalModule) [DotCabalDescriptor]
names0)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
if forall k a. Map k a -> Bool
M.null Map ModuleName b
unlistedModules
then []
else [ NamedComponent -> [ModuleName] -> PackageWarning
UnlistedModulesWarning
NamedComponent
component
(forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall k a. Map k a -> [(k, a)]
M.toList Map ModuleName b
unlistedModules))]
warnMissing :: p -> m [a]
warnMissing p
_missingModules = do
forall (m :: * -> *) a. Monad m => a -> m a
return []
toResolvedModule
:: (DotCabalDescriptor, Maybe DotCabalPath)
-> Maybe (ModuleName, Path Abs File)
toResolvedModule :: (DotCabalDescriptor, Maybe DotCabalPath)
-> Maybe (ModuleName, Path Abs File)
toResolvedModule (DotCabalModule ModuleName
mn, Just (DotCabalModulePath Path Abs File
fp)) =
forall a. a -> Maybe a
Just (ModuleName
mn, Path Abs File
fp)
toResolvedModule (DotCabalDescriptor, Maybe DotCabalPath)
_ =
forall a. Maybe a
Nothing
toMissingModule
:: (DotCabalDescriptor, Maybe DotCabalPath)
-> Maybe ModuleName
toMissingModule :: (DotCabalDescriptor, Maybe DotCabalPath) -> Maybe ModuleName
toMissingModule (DotCabalModule ModuleName
mn, Maybe DotCabalPath
Nothing) =
forall a. a -> Maybe a
Just ModuleName
mn
toMissingModule (DotCabalDescriptor, Maybe DotCabalPath)
_ =
forall a. Maybe a
Nothing
getDependencies
:: NamedComponent -> [Path Abs Dir] -> DotCabalPath -> RIO Ctx (Set ModuleName, [Path Abs File])
getDependencies :: NamedComponent
-> [Path Abs Dir]
-> DotCabalPath
-> RIO Ctx (Set ModuleName, [Path Abs File])
getDependencies NamedComponent
component [Path Abs Dir]
dirs DotCabalPath
dotCabalPath =
case DotCabalPath
dotCabalPath of
DotCabalModulePath Path Abs File
resolvedFile -> forall {t}. Path Abs t -> RIO Ctx (Set ModuleName, [Path Abs File])
readResolvedHi Path Abs File
resolvedFile
DotCabalMainPath Path Abs File
resolvedFile -> forall {t}. Path Abs t -> RIO Ctx (Set ModuleName, [Path Abs File])
readResolvedHi Path Abs File
resolvedFile
DotCabalFilePath{} -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Set a
S.empty, [])
DotCabalCFilePath{} -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Set a
S.empty, [])
where
readResolvedHi :: Path Abs t -> RIO Ctx (Set ModuleName, [Path Abs File])
readResolvedHi Path Abs t
resolvedFile = do
Path Abs Dir
dumpHIDir <- NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir NamedComponent
component forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Path Abs Dir
ctxDistDir
Path Abs Dir
dir <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall b t. Path b t -> Path b Dir
parent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
let sourceDir :: Path Abs Dir
sourceDir = forall a. a -> Maybe a -> a
fromMaybe Path Abs Dir
dir forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall b t. Path b Dir -> Path b t -> Bool
`isProperPrefixOf` Path Abs t
resolvedFile) [Path Abs Dir]
dirs
stripSourceDir :: Path Abs Dir -> m (Path Rel t)
stripSourceDir Path Abs Dir
d = forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix Path Abs Dir
d Path Abs t
resolvedFile
case forall {m :: * -> *}.
MonadThrow m =>
Path Abs Dir -> m (Path Rel t)
stripSourceDir Path Abs Dir
sourceDir of
Maybe (Path Rel t)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Set a
S.empty, [])
Just Path Rel t
fileRel -> do
let hiPath :: String
hiPath =
String -> String -> String
FilePath.replaceExtension
(forall b t. Path b t -> String
toFilePath (Path Abs Dir
dumpHIDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel t
fileRel))
String
".hi"
Bool
dumpHIExists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
D.doesFileExist String
hiPath
if Bool
dumpHIExists
then String -> RIO Ctx (Set ModuleName, [Path Abs File])
parseHI String
hiPath
else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Set a
S.empty, [])
parseHI
:: FilePath -> RIO Ctx (Set ModuleName, [Path Abs File])
parseHI :: String -> RIO Ctx (Set ModuleName, [Path Abs File])
parseHI String
hiPath = do
Path Abs Dir
dir <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall b t. Path b t -> Path b Dir
parent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
Either String Interface
result <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO (Either String Interface)
Iface.fromFile String
hiPath forall a (m :: * -> *).
(NFData a, MonadUnliftIO m) =>
m a -> (SomeException -> m a) -> m a
`catchAnyDeep` \SomeException
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (forall a. Show a => a -> String
show SomeException
e))
case Either String Interface
result of
Left String
msg -> do
forall env. HasConfig env => [StyleDoc] -> RIO env ()
prettyStackDevL
[ String -> StyleDoc
flow String
"Failed to decode module interface:"
, Style -> StyleDoc -> StyleDoc
style Style
File forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
hiPath
, String -> StyleDoc
flow String
"Decoding failure:"
, Style -> StyleDoc -> StyleDoc
style Style
Error forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
msg
]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Set a
S.empty, [])
Right Interface
iface -> do
let moduleNames :: Interface -> [ModuleName]
moduleNames = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8Lenient forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. List a -> [a]
Iface.unList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> List (ByteString, Bool)
Iface.dmods forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> Dependencies
Iface.deps
resolveFileDependency :: String -> m (Maybe (Path Abs File))
resolveFileDependency String
file = do
Maybe (Path Abs File)
resolved <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Maybe (Path Abs File))
forgivingResolveFile Path Abs Dir
dir String
file) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs File) -> m (Maybe (Path Abs File))
rejectMissingFile
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe (Path Abs File)
resolved) forall a b. (a -> b) -> a -> b
$
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ String -> StyleDoc
flow String
"Dependent file listed in:"
, Style -> StyleDoc -> StyleDoc
style Style
File forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
hiPath
, String -> StyleDoc
flow String
"does not exist:"
, Style -> StyleDoc -> StyleDoc
style Style
File forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
file
]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs File)
resolved
resolveUsages :: Interface -> RIO Ctx [Maybe (Path Abs File)]
resolveUsages = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall {m :: * -> *} {env}.
(MonadIO m, HasTerm env, MonadReader env m) =>
String -> m (Maybe (Path Abs File))
resolveFileDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. Usage -> String
Iface.unUsage) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. List a -> [a]
Iface.unList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> List Usage
Iface.usage
[Path Abs File]
resolvedUsages <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Interface -> RIO Ctx [Maybe (Path Abs File)]
resolveUsages Interface
iface
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ Interface -> [ModuleName]
moduleNames Interface
iface, [Path Abs File]
resolvedUsages)
resolveFiles
:: [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO Ctx [(DotCabalDescriptor, Maybe DotCabalPath)]
resolveFiles :: [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO Ctx [(DotCabalDescriptor, Maybe DotCabalPath)]
resolveFiles [Path Abs Dir]
dirs [DotCabalDescriptor]
names =
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [DotCabalDescriptor]
names (\DotCabalDescriptor
name -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (DotCabalDescriptor
name, ) ([Path Abs Dir]
-> DotCabalDescriptor -> RIO Ctx (Maybe DotCabalPath)
findCandidate [Path Abs Dir]
dirs DotCabalDescriptor
name))
data CabalFileNameParseFail
= CabalFileNameParseFail FilePath
| CabalFileNameInvalidPackageName FilePath
deriving (Typeable)
instance Exception CabalFileNameParseFail
instance Show CabalFileNameParseFail where
show :: CabalFileNameParseFail -> String
show (CabalFileNameParseFail String
fp) = String
"Invalid file path for cabal file, must have a .cabal extension: " forall a. [a] -> [a] -> [a]
++ String
fp
show (CabalFileNameInvalidPackageName String
fp) = String
"cabal file names must use valid package names followed by a .cabal extension, the following is invalid: " forall a. [a] -> [a] -> [a]
++ String
fp
parsePackageNameFromFilePath :: MonadThrow m => Path a File -> m PackageName
parsePackageNameFromFilePath :: forall (m :: * -> *) a.
MonadThrow m =>
Path a File -> m PackageName
parsePackageNameFromFilePath Path a File
fp = do
String
base <- String -> m String
clean forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> String
toFilePath forall a b. (a -> b) -> a -> b
$ forall b. Path b File -> Path Rel File
filename Path a File
fp
case String -> Maybe PackageName
parsePackageName String
base of
Maybe PackageName
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> CabalFileNameParseFail
CabalFileNameInvalidPackageName forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> String
toFilePath Path a File
fp
Just PackageName
x -> forall (m :: * -> *) a. Monad m => a -> m a
return PackageName
x
where clean :: String -> m String
clean = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m :: * -> *}. MonadThrow m => String -> m String
strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
strip :: String -> m String
strip (Char
'l':Char
'a':Char
'b':Char
'a':Char
'c':Char
'.':String
xs) = forall (m :: * -> *) a. Monad m => a -> m a
return String
xs
strip String
_ = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (String -> CabalFileNameParseFail
CabalFileNameParseFail (forall b t. Path b t -> String
toFilePath Path a File
fp))
findCandidate
:: [Path Abs Dir]
-> DotCabalDescriptor
-> RIO Ctx (Maybe DotCabalPath)
findCandidate :: [Path Abs Dir]
-> DotCabalDescriptor -> RIO Ctx (Maybe DotCabalPath)
findCandidate [Path Abs Dir]
dirs DotCabalDescriptor
name = do
PackageName
pkg <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Path Abs File
ctxFile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
MonadThrow m =>
Path a File -> m PackageName
parsePackageNameFromFilePath
[Text]
customPreprocessorExts <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasConfig env => Lens' env Config
configL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to Config -> [Text]
configCustomPreprocessorExts
let haskellPreprocessorExts :: [Text]
haskellPreprocessorExts = [Text]
haskellDefaultPreprocessorExts forall a. [a] -> [a] -> [a]
++ [Text]
customPreprocessorExts
[Path Abs File]
candidates <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Text] -> IO [Path Abs File]
makeNameCandidates [Text]
haskellPreprocessorExts
case [Path Abs File]
candidates of
[Path Abs File
candidate] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (Path Abs File -> DotCabalPath
cons Path Abs File
candidate))
[] -> do
case DotCabalDescriptor
name of
DotCabalModule ModuleName
mn
| forall a. Pretty a => a -> String
display ModuleName
mn forall a. Eq a => a -> a -> Bool
/= PackageName -> String
paths_pkg PackageName
pkg -> forall env.
HasTerm env =>
[Path Abs Dir] -> ModuleName -> RIO env ()
logPossibilities [Path Abs Dir]
dirs ModuleName
mn
DotCabalDescriptor
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
(Path Abs File
candidate:[Path Abs File]
rest) -> do
forall b t.
DotCabalDescriptor -> Path b t -> [Path b t] -> RIO Ctx ()
warnMultiple DotCabalDescriptor
name Path Abs File
candidate [Path Abs File]
rest
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (Path Abs File -> DotCabalPath
cons Path Abs File
candidate))
where
cons :: Path Abs File -> DotCabalPath
cons =
case DotCabalDescriptor
name of
DotCabalModule{} -> Path Abs File -> DotCabalPath
DotCabalModulePath
DotCabalMain{} -> Path Abs File -> DotCabalPath
DotCabalMainPath
DotCabalFile{} -> Path Abs File -> DotCabalPath
DotCabalFilePath
DotCabalCFile{} -> Path Abs File -> DotCabalPath
DotCabalCFilePath
paths_pkg :: PackageName -> String
paths_pkg PackageName
pkg = String
"Paths_" forall a. [a] -> [a] -> [a]
++ PackageName -> String
packageNameString PackageName
pkg
makeNameCandidates :: [Text] -> IO [Path Abs File]
makeNameCandidates [Text]
haskellPreprocessorExts =
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Ord a => [a] -> [a]
nubOrd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Text] -> Path Abs Dir -> IO [Path Abs File]
makeDirCandidates [Text]
haskellPreprocessorExts) [Path Abs Dir]
dirs)
makeDirCandidates :: [Text]
-> Path Abs Dir
-> IO [Path Abs File]
makeDirCandidates :: [Text] -> Path Abs Dir -> IO [Path Abs File]
makeDirCandidates [Text]
haskellPreprocessorExts Path Abs Dir
dir =
case DotCabalDescriptor
name of
DotCabalMain String
fp -> forall {f :: * -> *}.
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> String -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir String
fp
DotCabalFile String
fp -> forall {f :: * -> *}.
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> String -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir String
fp
DotCabalCFile String
fp -> forall {f :: * -> *}.
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> String -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir String
fp
DotCabalModule ModuleName
mn -> do
let perExt :: Text -> f [Path Abs File]
perExt Text
ext =
forall {f :: * -> *}.
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> String -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir (ModuleName -> String
Cabal.toFilePath ModuleName
mn forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
ext)
[[Path Abs File]]
withHaskellExts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {f :: * -> *}.
(MonadIO f, MonadThrow f) =>
Text -> f [Path Abs File]
perExt [Text]
haskellFileExts
[[Path Abs File]]
withPPExts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {f :: * -> *}.
(MonadIO f, MonadThrow f) =>
Text -> f [Path Abs File]
perExt [Text]
haskellPreprocessorExts
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
case (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Path Abs File]]
withHaskellExts, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Path Abs File]]
withPPExts) of
([Path Abs File
_], [Path Abs File
y]) -> [Path Abs File
y]
([Path Abs File]
xs, [Path Abs File]
ys) -> [Path Abs File]
xs forall a. [a] -> [a] -> [a]
++ [Path Abs File]
ys
resolveCandidate :: Path Abs Dir -> String -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> String -> m (Maybe (Path Abs File))
resolveDirFile Path Abs Dir
dir
resolveDirFile
:: (MonadIO m, MonadThrow m)
=> Path Abs Dir -> FilePath.FilePath -> m (Maybe (Path Abs File))
resolveDirFile :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> String -> m (Maybe (Path Abs File))
resolveDirFile Path Abs Dir
x String
y = do
Path Abs File
p <- forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseCollapsedAbsFile (forall b t. Path b t -> String
toFilePath Path Abs Dir
x String -> String -> String
FilePath.</> String
y)
Bool
exists <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
p
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
exists then forall a. a -> Maybe a
Just Path Abs File
p else forall a. Maybe a
Nothing
warnMultiple
:: DotCabalDescriptor -> Path b t -> [Path b t] -> RIO Ctx ()
warnMultiple :: forall b t.
DotCabalDescriptor -> Path b t -> [Path b t] -> RIO Ctx ()
warnMultiple DotCabalDescriptor
name Path b t
candidate [Path b t]
rest =
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ String -> StyleDoc
flow String
"There were multiple candidates for the Cabal entry"
, forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCabalDescriptor -> String
showName forall a b. (a -> b) -> a -> b
$ DotCabalDescriptor
name
, StyleDoc
line forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList (forall a b. (a -> b) -> [a] -> [b]
map forall {b} {t}. Path b t -> StyleDoc
dispOne (Path b t
candidateforall a. a -> [a] -> [a]
:[Path b t]
rest))
, StyleDoc
line forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
flow String
"picking:"
, forall {b} {t}. Path b t -> StyleDoc
dispOne Path b t
candidate
]
where showName :: DotCabalDescriptor -> String
showName (DotCabalModule ModuleName
name') = forall a. Pretty a => a -> String
display ModuleName
name'
showName (DotCabalMain String
fp) = String
fp
showName (DotCabalFile String
fp) = String
fp
showName (DotCabalCFile String
fp) = String
fp
dispOne :: Path b t -> StyleDoc
dispOne = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> String
toFilePath
logPossibilities
:: HasTerm env
=> [Path Abs Dir] -> ModuleName -> RIO env ()
logPossibilities :: forall env.
HasTerm env =>
[Path Abs Dir] -> ModuleName -> RIO env ()
logPossibilities [Path Abs Dir]
dirs ModuleName
mn = do
[Path Rel File]
possibilities <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall {m :: * -> *} {a}.
(MonadIO m, Pretty a) =>
a -> m [[Path Rel File]]
makePossibilities ModuleName
mn)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path Rel File]
possibilities) forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ String -> StyleDoc
flow String
"Unable to find a known candidate for the Cabal entry"
, (Style -> StyleDoc -> StyleDoc
style Style
PP.Module forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> String
display ModuleName
mn) forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
, String -> StyleDoc
flow String
"but did find:"
, StyleDoc
line forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> StyleDoc
pretty [Path Rel File]
possibilities)
, String -> StyleDoc
flow String
"If you are using a custom preprocessor for this module"
, String -> StyleDoc
flow String
"with its own file extension, consider adding the extension"
, String -> StyleDoc
flow String
"to the 'custom-preprocessor-extensions' field in stack.yaml."
]
where
makePossibilities :: a -> m [[Path Rel File]]
makePossibilities a
name =
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
(\Path Abs Dir
dir ->
do ([Path Abs Dir]
_,[Path Abs File]
files) <- forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir Path Abs Dir
dir
forall (m :: * -> *) a. Monad m => a -> m a
return
(forall a b. (a -> b) -> [a] -> [b]
map
forall b. Path b File -> Path Rel File
filename
(forall a. (a -> Bool) -> [a] -> [a]
filter
(forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (forall a. Pretty a => a -> String
display a
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall b t. Path b t -> String
toFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Path b File -> Path Rel File
filename)
[Path Abs File]
files)))
[Path Abs Dir]
dirs
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 (m :: * -> *) a. Monad m => a -> m a
return 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
resolveOrWarn :: Text
-> (Path Abs Dir -> String -> RIO Ctx (Maybe a))
-> FilePath.FilePath
-> RIO Ctx (Maybe a)
resolveOrWarn :: forall a.
Text
-> (Path Abs Dir -> String -> RIO Ctx (Maybe a))
-> String
-> RIO Ctx (Maybe a)
resolveOrWarn Text
subject Path Abs Dir -> String -> RIO Ctx (Maybe a)
resolver String
path =
do Path Abs Dir
cwd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
Path Abs File
file <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Path Abs File
ctxFile
Path Abs Dir
dir <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall b t. Path b t -> Path b Dir
parent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
Maybe a
result <- Path Abs Dir -> String -> RIO Ctx (Maybe a)
resolver Path Abs Dir
dir String
path
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe a
result) forall a b. (a -> b) -> a -> b
$ Text -> Path Abs Dir -> String -> Path Abs File -> RIO Ctx ()
warnMissingFile Text
subject Path Abs Dir
cwd String
path Path Abs File
file
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
result
warnMissingFile :: Text -> Path Abs Dir -> FilePath -> Path Abs File -> RIO Ctx ()
warnMissingFile :: Text -> Path Abs Dir -> String -> Path Abs File -> RIO Ctx ()
warnMissingFile Text
subject Path Abs Dir
cwd String
path Path Abs File
fromFile =
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
subject
, String -> StyleDoc
flow String
"listed in"
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
fromFile) forall a. Pretty a => a -> StyleDoc
pretty (forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix Path Abs Dir
cwd Path Abs File
fromFile)
, String -> StyleDoc
flow String
"file does not exist:"
, Style -> StyleDoc -> StyleDoc
style Style
Dir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
path
]
resolveFileOrWarn :: FilePath.FilePath
-> RIO Ctx (Maybe (Path Abs File))
resolveFileOrWarn :: String -> RIO Ctx (Maybe (Path Abs File))
resolveFileOrWarn = forall a.
Text
-> (Path Abs Dir -> String -> RIO Ctx (Maybe a))
-> String
-> RIO Ctx (Maybe a)
resolveOrWarn Text
"File" forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Maybe (Path Abs File))
f
where f :: Path Abs Dir -> String -> m (Maybe (Path Abs File))
f Path Abs Dir
p String
x = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Maybe (Path Abs File))
forgivingResolveFile Path Abs Dir
p String
x) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs File) -> m (Maybe (Path Abs File))
rejectMissingFile
resolveDirOrWarn :: FilePath.FilePath
-> RIO Ctx (Maybe (Path Abs Dir))
resolveDirOrWarn :: String -> RIO Ctx (Maybe (Path Abs Dir))
resolveDirOrWarn = forall a.
Text
-> (Path Abs Dir -> String -> RIO Ctx (Maybe a))
-> String
-> RIO Ctx (Maybe a)
resolveOrWarn Text
"Directory" forall {m :: * -> *}.
MonadIO m =>
Path Abs Dir -> String -> m (Maybe (Path Abs Dir))
f
where f :: Path Abs Dir -> String -> m (Maybe (Path Abs Dir))
f Path Abs Dir
p String
x = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs Dir)
resolveDir Path Abs Dir
p String
x)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs Dir) -> m (Maybe (Path Abs Dir))
rejectMissingDir
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)