{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
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.Compiler
import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as Cabal
import qualified Distribution.Package as D
import Distribution.Package hiding (Package,PackageName,packageName,packageVersion,PackageIdentifier)
import qualified Distribution.PackageDescription as D
import Distribution.PackageDescription hiding (FlagName)
import Distribution.PackageDescription.Parsec
import Distribution.Pretty (prettyShow)
import Distribution.Simple.Glob (matchDirFileGlob)
import Distribution.System (OS (..), Arch, Platform (..))
import qualified Distribution.Text as D
import qualified Distribution.Types.CondTree as Cabal
import qualified Distribution.Types.ExeDependency as Cabal
import Distribution.Types.ForeignLib
import qualified Distribution.Types.LegacyExeDependency as Cabal
import Distribution.Types.LibraryName (libraryNameString, maybeToLibraryName)
import Distribution.Types.MungedPackageName
import qualified Distribution.Types.UnqualComponentName as Cabal
import qualified Distribution.Verbosity as D
import Distribution.Version (mkVersion, orLaterVersion, anyVersion)
import qualified HiFileParser as Iface
#if MIN_VERSION_path(0,7,0)
import Path as FL hiding (replaceExtension)
#else
import Path as FL
#endif
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
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 :: (LogFunc -> f LogFunc) -> Ctx -> f Ctx
logFuncL = (Config -> f Config) -> Ctx -> f Ctx
forall env. HasConfig env => Lens' env Config
configL((Config -> f Config) -> Ctx -> f Ctx)
-> ((LogFunc -> f LogFunc) -> Config -> f Config)
-> (LogFunc -> f LogFunc)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(LogFunc -> f LogFunc) -> Config -> f Config
forall env. HasLogFunc env => Lens' env LogFunc
logFuncL
instance HasRunner Ctx where
runnerL :: (Runner -> f Runner) -> Ctx -> f Ctx
runnerL = (Config -> f Config) -> Ctx -> f Ctx
forall env. HasConfig env => Lens' env Config
configL((Config -> f Config) -> Ctx -> f Ctx)
-> ((Runner -> f Runner) -> Config -> f Config)
-> (Runner -> f Runner)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Runner -> f Runner) -> Config -> f Config
forall env. HasRunner env => Lens' env Runner
runnerL
instance HasStylesUpdate Ctx where
stylesUpdateL :: (StylesUpdate -> f StylesUpdate) -> Ctx -> f Ctx
stylesUpdateL = (Runner -> f Runner) -> Ctx -> f Ctx
forall env. HasRunner env => Lens' env Runner
runnerL((Runner -> f Runner) -> Ctx -> f Ctx)
-> ((StylesUpdate -> f StylesUpdate) -> Runner -> f Runner)
-> (StylesUpdate -> f StylesUpdate)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(StylesUpdate -> f StylesUpdate) -> Runner -> f Runner
forall env. HasStylesUpdate env => Lens' env StylesUpdate
stylesUpdateL
instance HasTerm Ctx where
useColorL :: (Bool -> f Bool) -> Ctx -> f Ctx
useColorL = (Runner -> f Runner) -> Ctx -> f Ctx
forall env. HasRunner env => Lens' env Runner
runnerL((Runner -> f Runner) -> Ctx -> f Ctx)
-> ((Bool -> f Bool) -> Runner -> f Runner)
-> (Bool -> f Bool)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> f Bool) -> Runner -> f Runner
forall env. HasTerm env => Lens' env Bool
useColorL
termWidthL :: (Int -> f Int) -> Ctx -> f Ctx
termWidthL = (Runner -> f Runner) -> Ctx -> f Ctx
forall env. HasRunner env => Lens' env Runner
runnerL((Runner -> f Runner) -> Ctx -> f Ctx)
-> ((Int -> f Int) -> Runner -> f Runner)
-> (Int -> f Int)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> f Int) -> Runner -> f Runner
forall env. HasTerm env => Lens' env Int
termWidthL
instance HasConfig Ctx
instance HasPantryConfig Ctx where
pantryConfigL :: (PantryConfig -> f PantryConfig) -> Ctx -> f Ctx
pantryConfigL = (Config -> f Config) -> Ctx -> f Ctx
forall env. HasConfig env => Lens' env Config
configL((Config -> f Config) -> Ctx -> f Ctx)
-> ((PantryConfig -> f PantryConfig) -> Config -> f Config)
-> (PantryConfig -> f PantryConfig)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PantryConfig -> f PantryConfig) -> Config -> f Config
forall env. HasPantryConfig env => Lens' env PantryConfig
pantryConfigL
instance HasProcessContext Ctx where
processContextL :: (ProcessContext -> f ProcessContext) -> Ctx -> f Ctx
processContextL = (Config -> f Config) -> Ctx -> f Ctx
forall env. HasConfig env => Lens' env Config
configL((Config -> f Config) -> Ctx -> f Ctx)
-> ((ProcessContext -> f ProcessContext) -> Config -> f Config)
-> (ProcessContext -> f ProcessContext)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ProcessContext -> f ProcessContext) -> Config -> f Config
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
instance HasBuildConfig Ctx where
buildConfigL :: (BuildConfig -> f BuildConfig) -> Ctx -> f Ctx
buildConfigL = (Ctx -> BuildConfig)
-> (Ctx -> BuildConfig -> Ctx) -> Lens' Ctx BuildConfig
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 :: Path Abs File -> m HookedBuildInfo
readDotBuildinfo Path Abs File
buildinfofp =
IO HookedBuildInfo -> m HookedBuildInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HookedBuildInfo -> m HookedBuildInfo)
-> IO HookedBuildInfo -> m HookedBuildInfo
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO HookedBuildInfo
readHookedBuildInfo Verbosity
D.silent (Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
buildinfofp)
resolvePackage :: PackageConfig
-> GenericPackageDescription
-> Package
resolvePackage :: PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
packageConfig GenericPackageDescription
gpkg =
PackageConfig -> [Flag] -> PackageDescriptionPair -> Package
packageFromPackageDescription
PackageConfig
packageConfig
(GenericPackageDescription -> [Flag]
genPackageFlags GenericPackageDescription
gpkg)
(PackageConfig
-> GenericPackageDescription -> PackageDescriptionPair
resolvePackageDescription PackageConfig
packageConfig GenericPackageDescription
gpkg)
packageFromPackageDescription :: PackageConfig
-> [D.Flag]
-> PackageDescriptionPair
-> Package
packageFromPackageDescription :: PackageConfig -> [Flag] -> PackageDescriptionPair -> Package
packageFromPackageDescription PackageConfig
packageConfig [Flag]
pkgFlags (PackageDescriptionPair PackageDescription
pkgNoMod PackageDescription
pkg) =
Package :: PackageName
-> Version
-> Either License License
-> GetPackageFiles
-> Map PackageName DepValue
-> Set ExeName
-> Set PackageName
-> [Text]
-> [Text]
-> Map FlagName Bool
-> Map FlagName Bool
-> PackageLibraries
-> Set Text
-> Map Text TestSuiteInterface
-> Set Text
-> Set Text
-> GetPackageOpts
-> Bool
-> BuildType
-> Maybe (Map PackageName VersionRange)
-> VersionRange
-> Package
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 = [(FlagName, Bool)] -> Map FlagName Bool
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[(Flag -> FlagName
flagName Flag
flag, Flag -> Bool
flagDefault Flag
flag) | Flag
flag <- [Flag]
pkgFlags]
, packageAllDeps :: Set PackageName
packageAllDeps = [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
S.fromList (Map PackageName DepValue -> [PackageName]
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
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ BuildInfo -> Bool
buildable (BuildInfo -> Bool) -> BuildInfo -> Bool
forall a b. (a -> b) -> a -> b
$ Library -> BuildInfo
libBuildInfo Library
lib
Library -> Maybe Library
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 = [(Text, TestSuiteInterface)] -> Map Text TestSuiteInterface
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[(FilePath -> Text
T.pack (UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
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 = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList
[FilePath -> Text
T.pack (UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
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 = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList
[FilePath -> Text
T.pack (UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
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 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)
-> (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
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
-> Path Abs File
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], 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 = Set Text -> [Text]
forall a. Set a -> [a]
S.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Set NamedComponent -> Set Text
internalLibComponents (Set NamedComponent -> Set Text) -> Set NamedComponent -> Set Text
forall a b. (a -> b) -> a -> b
$ Map NamedComponent (Map ModuleName (Path Abs File))
-> Set NamedComponent
forall k a. Map k a -> Set k
M.keysSet Map NamedComponent (Map ModuleName (Path Abs File))
componentsModules
[PackageName]
excludedInternals <- (Text -> RIO env PackageName) -> [Text] -> RIO env [PackageName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> RIO env PackageName
forall (m :: * -> *). MonadThrow m => FilePath -> m PackageName
parsePackageNameThrowing (FilePath -> RIO env PackageName)
-> (Text -> FilePath) -> Text -> RIO env PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) [Text]
internals
[PackageName]
mungedInternals <- (Text -> RIO env PackageName) -> [Text] -> RIO env [PackageName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> RIO env PackageName
forall (m :: * -> *). MonadThrow m => FilePath -> m PackageName
parsePackageNameThrowing (FilePath -> RIO env PackageName)
-> (Text -> FilePath) -> Text -> RIO env PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (Text -> Text) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Text
toInternalPackageMungedName) [Text]
internals
Map NamedComponent BuildInfoOpts
componentsOpts <-
InstallMap
-> InstalledMap
-> [PackageName]
-> [PackageName]
-> Path Abs File
-> PackageDescription
-> Map NamedComponent [DotCabalPath]
-> RIO env (Map NamedComponent BuildInfoOpts)
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 [PackageName] -> [PackageName] -> [PackageName]
forall a. [a] -> [a] -> [a]
++ [PackageName]
omitPkgs) ([PackageName]
mungedInternals [PackageName] -> [PackageName] -> [PackageName]
forall a. [a] -> [a] -> [a]
++ [PackageName]
addPkgs)
Path Abs File
cabalfp PackageDescription
pkg Map NamedComponent [DotCabalPath]
componentFiles
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath],
Map NamedComponent BuildInfoOpts)
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath],
Map NamedComponent BuildInfoOpts)
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 = Bool -> (Library -> Bool) -> Maybe Library -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
Bool
False
(Bool -> Bool
not (Bool -> Bool) -> (Library -> Bool) -> Library -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ModuleName] -> Bool)
-> (Library -> [ModuleName]) -> Library -> Bool
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 :: VersionRange
packageCabalSpec = (Version -> VersionRange)
-> (VersionRange -> VersionRange)
-> Either Version VersionRange
-> VersionRange
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Version -> VersionRange
orLaterVersion VersionRange -> VersionRange
forall a. a -> a
id (Either Version VersionRange -> VersionRange)
-> Either Version VersionRange -> VersionRange
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Either Version VersionRange
specVersionRaw PackageDescription
pkg
}
where
extraLibNames :: Set Text
extraLibNames = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Text
subLibNames Set Text
foreignLibNames
subLibNames :: Set Text
subLibNames
= [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList
([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ (UnqualComponentName -> Text) -> [UnqualComponentName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Text
T.pack (FilePath -> Text)
-> (UnqualComponentName -> FilePath) -> UnqualComponentName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> FilePath
Cabal.unUnqualComponentName)
([UnqualComponentName] -> [Text])
-> [UnqualComponentName] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Library -> Maybe UnqualComponentName)
-> [Library] -> [UnqualComponentName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LibraryName -> Maybe UnqualComponentName
libraryNameString (LibraryName -> Maybe UnqualComponentName)
-> (Library -> LibraryName) -> Library -> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName)
([Library] -> [UnqualComponentName])
-> [Library] -> [UnqualComponentName]
forall a b. (a -> b) -> a -> b
$ (Library -> Bool) -> [Library] -> [Library]
forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> Bool
buildable (BuildInfo -> Bool) -> (Library -> BuildInfo) -> Library -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo)
([Library] -> [Library]) -> [Library] -> [Library]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Library]
subLibraries PackageDescription
pkg
foreignLibNames :: Set Text
foreignLibNames
= [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList
([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ (ForeignLib -> Text) -> [ForeignLib] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Text
T.pack (FilePath -> Text)
-> (ForeignLib -> FilePath) -> ForeignLib -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> FilePath)
-> (ForeignLib -> UnqualComponentName) -> ForeignLib -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> UnqualComponentName
foreignLibName)
([ForeignLib] -> [Text]) -> [ForeignLib] -> [Text]
forall a b. (a -> b) -> a -> b
$ (ForeignLib -> Bool) -> [ForeignLib] -> [ForeignLib]
forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> Bool
buildable (BuildInfo -> Bool)
-> (ForeignLib -> BuildInfo) -> ForeignLib -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> BuildInfo
foreignLibBuildInfo)
([ForeignLib] -> [ForeignLib]) -> [ForeignLib] -> [ForeignLib]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [ForeignLib]
foreignLibs PackageDescription
pkg
toInternalPackageMungedName :: Text -> Text
toInternalPackageMungedName
= FilePath -> Text
T.pack (FilePath -> Text) -> (Text -> FilePath) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MungedPackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (MungedPackageName -> FilePath)
-> (Text -> MungedPackageName) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> LibraryName -> MungedPackageName
MungedPackageName (PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId)
(LibraryName -> MungedPackageName)
-> (Text -> LibraryName) -> Text -> MungedPackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UnqualComponentName -> LibraryName
maybeToLibraryName (Maybe UnqualComponentName -> LibraryName)
-> (Text -> Maybe UnqualComponentName) -> Text -> LibraryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> Maybe UnqualComponentName
forall a. a -> Maybe a
Just (UnqualComponentName -> Maybe UnqualComponentName)
-> (Text -> UnqualComponentName)
-> Text
-> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> UnqualComponentName
Cabal.mkUnqualComponentName (FilePath -> UnqualComponentName)
-> (Text -> FilePath) -> Text -> UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
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 env.
HasEnvConfig env =>
Path Abs File
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], 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
forall a b. (a -> b) -> a -> b
$
\Path Abs File
cabalfp -> StyleDoc
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
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
<+> Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
cabalfp) (RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning]))
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
forall a b. (a -> b) -> a -> b
$ do
let pkgDir :: Path Abs Dir
pkgDir = Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
cabalfp
Path Abs Dir
distDir <- Path Abs Dir -> RIO env (Path Abs Dir)
forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs Dir)
distDirFromDir Path Abs Dir
pkgDir
BuildConfig
bc <- Getting BuildConfig env BuildConfig -> RIO env BuildConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildConfig env BuildConfig
forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL
Version
cabalVer <- Getting Version env Version -> RIO env Version
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Version env Version
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) <-
Ctx
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
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 BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Custom
then do
let setupHsPath :: Path Abs File
setupHsPath = Path Abs Dir
pkgDir Path Abs Dir -> Path Rel File -> Path Abs File
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 Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileSetupLhs
Bool
setupHsExists <- Path Abs File -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
setupHsPath
if Bool
setupHsExists then Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs File -> Set (Path Abs File)
forall a. a -> Set a
S.singleton Path Abs File
setupHsPath) else do
Bool
setupLhsExists <- Path Abs File -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
setupLhsPath
if Bool
setupLhsExists then Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs File -> Set (Path Abs File)
forall a. a -> Set a
S.singleton Path Abs File
setupLhsPath) else Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall (m :: * -> *) a. Monad m => a -> m a
return Set (Path Abs File)
forall a. Set a
S.empty
else Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall (m :: * -> *) a. Monad m => a -> m a
return Set (Path Abs File)
forall a. Set a
S.empty
Set (Path Abs File)
buildFiles <- (Set (Path Abs File) -> Set (Path Abs File))
-> RIO env (Set (Path Abs File)) -> RIO env (Set (Path Abs File))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Path Abs File -> Set (Path Abs File) -> Set (Path Abs File)
forall a. Ord a => a -> Set a -> Set a
S.insert Path Abs File
cabalfp (Set (Path Abs File) -> Set (Path Abs File))
-> (Set (Path Abs File) -> Set (Path Abs File))
-> Set (Path Abs File)
-> Set (Path Abs File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Path Abs File) -> Set (Path Abs File) -> Set (Path Abs File)
forall a. Ord a => Set a -> Set a -> Set a
S.union Set (Path Abs File)
setupFiles) (RIO env (Set (Path Abs File)) -> RIO env (Set (Path Abs File)))
-> RIO env (Set (Path Abs File)) -> RIO env (Set (Path Abs File))
forall a b. (a -> b) -> a -> b
$ do
let hpackPath :: Path Abs File
hpackPath = Path Abs Dir
pkgDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileHpackPackageConfig
Bool
hpackExists <- Path Abs File -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
hpackPath
Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall (m :: * -> *) a. Monad m => a -> m a
return (Set (Path Abs File) -> RIO env (Set (Path Abs File)))
-> Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall a b. (a -> b) -> a -> b
$ if Bool
hpackExists then Path Abs File -> Set (Path Abs File)
forall a. a -> Set a
S.singleton Path Abs File
hpackPath else Set (Path Abs File)
forall a. Set a
S.empty
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
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 Set (Path Abs File) -> Set (Path Abs File) -> Set (Path Abs File)
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 = (PackageName -> DepValue -> Bool)
-> Map PackageName DepValue -> Map PackageName DepValue
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (Bool -> DepValue -> Bool
forall a b. a -> b -> a
const (Bool -> DepValue -> Bool)
-> (PackageName -> Bool) -> PackageName -> DepValue -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (PackageName -> Bool) -> PackageName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> Bool
isMe) ((DepValue -> DepValue -> DepValue)
-> [Map PackageName DepValue] -> Map PackageName DepValue
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith DepValue -> DepValue -> DepValue
forall a. Semigroup a => a -> a -> a
(<>)
[ VersionRange -> DepValue
asLibrary (VersionRange -> DepValue)
-> Map PackageName VersionRange -> Map PackageName DepValue
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 (VersionRange -> DepValue)
-> Map PackageName VersionRange -> Map PackageName DepValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PackageName VersionRange
-> Maybe (Map PackageName VersionRange)
-> Map PackageName VersionRange
forall a. a -> Maybe a -> a
fromMaybe Map PackageName VersionRange
forall k a. Map k a
M.empty Maybe (Map PackageName VersionRange)
msetupDeps
, Map PackageName DepValue
knownTools
])
msetupDeps :: Maybe (Map PackageName VersionRange)
msetupDeps = (SetupBuildInfo -> Map PackageName VersionRange)
-> Maybe SetupBuildInfo -> Maybe (Map PackageName VersionRange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
([(PackageName, VersionRange)] -> Map PackageName VersionRange
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PackageName, VersionRange)] -> Map PackageName VersionRange)
-> (SetupBuildInfo -> [(PackageName, VersionRange)])
-> SetupBuildInfo
-> Map PackageName VersionRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dependency -> (PackageName, VersionRange))
-> [Dependency] -> [(PackageName, VersionRange)]
forall a b. (a -> b) -> [a] -> [b]
map (Dependency -> PackageName
depPkgName (Dependency -> PackageName)
-> (Dependency -> VersionRange)
-> Dependency
-> (PackageName, VersionRange)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Dependency -> VersionRange
depVerRange) ([Dependency] -> [(PackageName, VersionRange)])
-> (SetupBuildInfo -> [Dependency])
-> SetupBuildInfo
-> [(PackageName, VersionRange)]
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 :: VersionRange -> DepType -> DepValue
DepValue
{ dvVersionRange :: VersionRange
dvVersionRange = VersionRange
range
, dvType :: DepType
dvType = DepType
AsLibrary
}
isMe :: PackageName -> Bool
isMe PackageName
name' = PackageName
name' PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
name Bool -> Bool -> Bool
|| FilePath -> Text
forall a. IsString a => FilePath -> a
fromString (PackageName -> FilePath
packageNameString PackageName
name') Text -> Set Text -> Bool
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 :: 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 <- Getting Config env Config -> m Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config env Config
forall env. HasConfig env => Lens' env Config
configL
Version
cabalVer <- Getting Version env Version -> m Version
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Version env Version
forall env. HasCompiler env => SimpleGetter env Version
cabalVersionL
Path Abs Dir
distDir <- Path Abs Dir -> m (Path Abs Dir)
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 :: InstallMap
-> InstalledMap
-> Path Abs Dir
-> Path Abs Dir
-> [PackageName]
-> [PackageName]
-> BuildInfo
-> [DotCabalPath]
-> [FilePath]
-> [FilePath]
-> NamedComponent
-> Version
-> BioInput
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 = [DotCabalPath] -> Maybe [DotCabalPath] -> [DotCabalPath]
forall a. a -> Maybe a -> a
fromMaybe [] (NamedComponent
-> Map NamedComponent [DotCabalPath] -> Maybe [DotCabalPath]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup NamedComponent
namedComponent Map NamedComponent [DotCabalPath]
componentPaths)
, biConfigLibDirs :: [FilePath]
biConfigLibDirs = Config -> [FilePath]
configExtraLibDirs Config
config
, biConfigIncludeDirs :: [FilePath]
biConfigIncludeDirs = Config -> [FilePath]
configExtraIncludeDirs Config
config
, biComponentName :: NamedComponent
biComponentName = NamedComponent
namedComponent
, biCabalVersion :: Version
biCabalVersion = Version
cabalVer
}
)
Map NamedComponent BuildInfoOpts
-> m (Map NamedComponent BuildInfoOpts)
forall (m :: * -> *) a. Monad m => a -> m a
return
( [(NamedComponent, BuildInfoOpts)]
-> Map NamedComponent BuildInfoOpts
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
([[(NamedComponent, BuildInfoOpts)]]
-> [(NamedComponent, BuildInfoOpts)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [(NamedComponent, BuildInfoOpts)]
-> (Library -> [(NamedComponent, BuildInfoOpts)])
-> Maybe Library
-> [(NamedComponent, BuildInfoOpts)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
[]
((NamedComponent, BuildInfoOpts)
-> [(NamedComponent, BuildInfoOpts)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamedComponent, BuildInfoOpts)
-> [(NamedComponent, BuildInfoOpts)])
-> (Library -> (NamedComponent, BuildInfoOpts))
-> Library
-> [(NamedComponent, BuildInfoOpts)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate NamedComponent
CLib (BuildInfo -> (NamedComponent, BuildInfoOpts))
-> (Library -> BuildInfo)
-> Library
-> (NamedComponent, BuildInfoOpts)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo)
(PackageDescription -> Maybe Library
library PackageDescription
pkg)
, (Library -> Maybe (NamedComponent, BuildInfoOpts))
-> [Library] -> [(NamedComponent, BuildInfoOpts)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(\Library
sublib -> do
let maybeLib :: Maybe NamedComponent
maybeLib = Text -> NamedComponent
CInternalLib (Text -> NamedComponent)
-> (UnqualComponentName -> Text)
-> UnqualComponentName
-> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text)
-> (UnqualComponentName -> FilePath) -> UnqualComponentName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> NamedComponent)
-> Maybe UnqualComponentName -> Maybe NamedComponent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LibraryName -> Maybe UnqualComponentName
libraryNameString (LibraryName -> Maybe UnqualComponentName)
-> (Library -> LibraryName) -> Library -> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName) Library
sublib
(NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts))
-> BuildInfo -> NamedComponent -> (NamedComponent, BuildInfoOpts)
forall a b c. (a -> b -> c) -> b -> a -> c
flip NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate (Library -> BuildInfo
libBuildInfo Library
sublib) (NamedComponent -> (NamedComponent, BuildInfoOpts))
-> Maybe NamedComponent -> Maybe (NamedComponent, BuildInfoOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NamedComponent
maybeLib
)
(PackageDescription -> [Library]
subLibraries PackageDescription
pkg)
, (Executable -> (NamedComponent, BuildInfoOpts))
-> [Executable] -> [(NamedComponent, BuildInfoOpts)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\Executable
exe ->
NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate
(Text -> NamedComponent
CExe (FilePath -> Text
T.pack (UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (Executable -> UnqualComponentName
exeName Executable
exe))))
(Executable -> BuildInfo
buildInfo Executable
exe))
(PackageDescription -> [Executable]
executables PackageDescription
pkg)
, (Benchmark -> (NamedComponent, BuildInfoOpts))
-> [Benchmark] -> [(NamedComponent, BuildInfoOpts)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\Benchmark
bench ->
NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate
(Text -> NamedComponent
CBench (FilePath -> Text
T.pack (UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (Benchmark -> UnqualComponentName
benchmarkName Benchmark
bench))))
(Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bench))
(PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg)
, (TestSuite -> (NamedComponent, BuildInfoOpts))
-> [TestSuite] -> [(NamedComponent, BuildInfoOpts)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\TestSuite
test ->
NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate
(Text -> NamedComponent
CTest (FilePath -> Text
T.pack (UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (TestSuite -> UnqualComponentName
testName TestSuite
test))))
(TestSuite -> BuildInfo
testBuildInfo TestSuite
test))
(PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg)]))
where
cabalDir :: Path Abs Dir
cabalDir = Path Abs File -> Path Abs Dir
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 -> [FilePath]
biConfigLibDirs :: ![FilePath]
, BioInput -> [FilePath]
biConfigIncludeDirs :: ![FilePath]
, BioInput -> NamedComponent
biComponentName :: !NamedComponent
, BioInput -> Version
biCabalVersion :: !Version
}
generateBuildInfoOpts :: BioInput -> BuildInfoOpts
generateBuildInfoOpts :: BioInput -> BuildInfoOpts
generateBuildInfoOpts BioInput {[FilePath]
[PackageName]
[DotCabalPath]
BuildInfo
Version
InstallMap
InstalledMap
Path Abs Dir
NamedComponent
biCabalVersion :: Version
biComponentName :: NamedComponent
biConfigIncludeDirs :: [FilePath]
biConfigLibDirs :: [FilePath]
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 -> [FilePath]
biConfigLibDirs :: BioInput -> [FilePath]
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 :: [FilePath]
-> [FilePath] -> [FilePath] -> Path Abs File -> BuildInfoOpts
BuildInfoOpts
{ bioOpts :: [FilePath]
bioOpts = [FilePath]
ghcOpts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [FilePath]
cppOptions BuildInfo
biBuildInfo
, bioOneWordOpts :: [FilePath]
bioOneWordOpts = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[[FilePath]
extOpts, [FilePath]
srcOpts, [FilePath]
includeOpts, [FilePath]
libOpts, [FilePath]
fworks, [FilePath]
cObjectFiles]
, bioPackageFlags :: [FilePath]
bioPackageFlags = [FilePath]
deps
, bioCabalMacros :: Path Abs File
bioCabalMacros = Path Abs Dir
componentAutogen Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileCabalMacrosH
}
where
cObjectFiles :: [FilePath]
cObjectFiles =
(Path Abs File -> Maybe FilePath) -> [Path Abs File] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Path Abs File -> FilePath)
-> Maybe (Path Abs File) -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Maybe (Path Abs File) -> Maybe FilePath)
-> (Path Abs File -> Maybe (Path Abs File))
-> Path Abs File
-> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Path Abs Dir
-> NamedComponent
-> Path Abs Dir
-> Path Abs File
-> Maybe (Path Abs File)
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 = (DotCabalPath -> Maybe (Path Abs File))
-> [DotCabalPath] -> [Path Abs File]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DotCabalPath -> Maybe (Path Abs File)
dotCabalCFilePath [DotCabalPath]
biDotCabalPaths
installVersion :: (a, b) -> b
installVersion = (a, b) -> b
forall a b. (a, b) -> b
snd
deps :: [FilePath]
deps =
[[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ case PackageName -> InstalledMap -> Maybe (InstallLocation, Installed)
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)
_) -> [FilePath
"-package-id=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> GhcPkgId -> FilePath
ghcPkgIdString GhcPkgId
ipid]
Maybe (InstallLocation, Installed)
_ -> [FilePath
"-package=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> PackageName -> FilePath
packageNameString PackageName
name FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
FilePath
-> ((InstallLocation, Version) -> FilePath)
-> Maybe (InstallLocation, Version)
-> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
""
(((FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Version -> FilePath) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> FilePath
versionString) (Version -> FilePath)
-> ((InstallLocation, Version) -> Version)
-> (InstallLocation, Version)
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstallLocation, Version) -> Version
forall a b. (a, b) -> b
installVersion)
(PackageName -> InstallMap -> Maybe (InstallLocation, Version)
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 [PackageName] -> [PackageName] -> [PackageName]
forall a. [a] -> [a] -> [a]
++
[ PackageName
name
| Dependency PackageName
name VersionRange
_ Set LibraryName
_ <- BuildInfo -> [Dependency]
targetBuildDepends BuildInfo
biBuildInfo
, PackageName
name PackageName -> [PackageName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageName]
biOmitPackages]
PerCompilerFlavor [FilePath]
ghcOpts [FilePath]
_ = BuildInfo -> PerCompilerFlavor [FilePath]
options BuildInfo
biBuildInfo
extOpts :: [FilePath]
extOpts = (Extension -> FilePath) -> [Extension] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
"-X" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (Extension -> FilePath) -> Extension -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> FilePath
forall a. Pretty a => a -> FilePath
D.display) (BuildInfo -> [Extension]
usedExtensions BuildInfo
biBuildInfo)
srcOpts :: [FilePath]
srcOpts =
(Path Abs Dir -> FilePath) -> [Path Abs Dir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
"-i" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Path Abs Dir -> FilePath) -> Path Abs Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep)
([[Path Abs Dir]] -> [Path Abs Dir]
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
| [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
biBuildInfo)
]
, (FilePath -> Maybe (Path Abs Dir)) -> [FilePath] -> [Path Abs Dir]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FilePath -> Maybe (Path Abs Dir)
toIncludeDir (BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
biBuildInfo)
, [ Path Abs Dir
componentAutogen ]
, Maybe (Path Abs Dir) -> [Path Abs Dir]
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 ]
]) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"-stubdir=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
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 :: FilePath -> Maybe (Path Abs Dir)
toIncludeDir FilePath
"." = Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just Path Abs Dir
biCabalDir
toIncludeDir FilePath
relDir = Path Abs Dir -> FilePath -> Maybe (Path Abs Dir)
forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir -> FilePath -> m (Path Abs Dir)
concatAndColapseAbsDir Path Abs Dir
biCabalDir FilePath
relDir
includeOpts :: [FilePath]
includeOpts =
(FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"-I" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) ([FilePath]
biConfigIncludeDirs [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
pkgIncludeOpts)
pkgIncludeOpts :: [FilePath]
pkgIncludeOpts =
[ Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
absDir
| FilePath
dir <- BuildInfo -> [FilePath]
includeDirs BuildInfo
biBuildInfo
, Path Abs Dir
absDir <- FilePath -> [Path Abs Dir]
handleDir FilePath
dir
]
libOpts :: [FilePath]
libOpts =
(FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"-l" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (BuildInfo -> [FilePath]
extraLibs BuildInfo
biBuildInfo) [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<>
(FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"-L" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) ([FilePath]
biConfigLibDirs [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
pkgLibDirs)
pkgLibDirs :: [FilePath]
pkgLibDirs =
[ Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
absDir
| FilePath
dir <- BuildInfo -> [FilePath]
extraLibDirs BuildInfo
biBuildInfo
, Path Abs Dir
absDir <- FilePath -> [Path Abs Dir]
handleDir FilePath
dir
]
handleDir :: FilePath -> [Path Abs Dir]
handleDir FilePath
dir = case (FilePath -> Maybe (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir FilePath
dir, FilePath -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir FilePath
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 Path Abs Dir -> Path Rel Dir -> Path Abs Dir
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 :: [FilePath]
fworks = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
fwk -> FilePath
"-framework=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fwk) (BuildInfo -> [FilePath]
frameworks BuildInfo
biBuildInfo)
makeObjectFilePathFromC
:: MonadThrow m
=> Path Abs Dir
-> NamedComponent
-> Path Abs Dir
-> Path Abs File
-> m (Path Abs File)
makeObjectFilePathFromC :: 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 <- Path Abs Dir -> Path Abs File -> m (Path Rel File)
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 <-
FilePath -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile (FilePath -> FilePath -> FilePath
replaceExtension (Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Rel File
relCFilePath) FilePath
"o")
Path Abs File -> m (Path Abs File)
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir NamedComponent
namedComponent Path Abs Dir
distDir Path Abs Dir -> Path Rel File -> Path Abs File
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 Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
2, Int
0] = Maybe (Path Abs Dir)
forall a. Maybe a
Nothing
| Bool
otherwise = Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just (Path Abs Dir -> Maybe (Path Abs Dir))
-> Path Abs Dir -> Maybe (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
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 Path Abs Dir -> Path Rel Dir -> Path Abs Dir
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 Version -> Version -> Bool
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 Path Abs Dir -> Path Rel Dir -> Path Abs Dir
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 Path Abs Dir -> Path Rel Dir -> Path Abs Dir
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 Path Abs Dir -> Path Rel Dir -> Path Abs Dir
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 Path Abs Dir -> Path Rel Dir -> Path Abs Dir
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 Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Text -> Path Rel Dir
componentNameToDir (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
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 Path Abs Dir -> Path Rel Dir -> Path Abs Dir
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 =
Path Rel Dir -> Maybe (Path Rel Dir) -> Path Rel Dir
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Path Rel Dir
forall a. HasCallStack => FilePath -> a
error FilePath
"Invariant violated: component names should always parse as directory names")
(FilePath -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir (Text -> FilePath
T.unpack Text
name))
packageDependencies
:: PackageConfig
-> PackageDescription
-> Map PackageName VersionRange
packageDependencies :: PackageConfig -> PackageDescription -> Map PackageName VersionRange
packageDependencies PackageConfig
pkgConfig PackageDescription
pkg' =
(VersionRange -> VersionRange -> VersionRange)
-> [(PackageName, VersionRange)] -> Map PackageName VersionRange
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith VersionRange -> VersionRange -> VersionRange
intersectVersionRanges ([(PackageName, VersionRange)] -> Map PackageName VersionRange)
-> [(PackageName, VersionRange)] -> Map PackageName VersionRange
forall a b. (a -> b) -> a -> b
$
(Dependency -> (PackageName, VersionRange))
-> [Dependency] -> [(PackageName, VersionRange)]
forall a b. (a -> b) -> [a] -> [b]
map (Dependency -> PackageName
depPkgName (Dependency -> PackageName)
-> (Dependency -> VersionRange)
-> Dependency
-> (PackageName, VersionRange)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Dependency -> VersionRange
depVerRange) ([Dependency] -> [(PackageName, VersionRange)])
-> [Dependency] -> [(PackageName, VersionRange)]
forall a b. (a -> b) -> a -> b
$
(BuildInfo -> [Dependency]) -> [BuildInfo] -> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [Dependency]
targetBuildDepends (PackageDescription -> [BuildInfo]
allBuildInfo' PackageDescription
pkg) [Dependency] -> [Dependency] -> [Dependency]
forall a. [a] -> [a] -> [a]
++
[Dependency]
-> (SetupBuildInfo -> [Dependency])
-> Maybe SetupBuildInfo
-> [Dependency]
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) Version -> Version -> Bool
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) }) (Library -> Library) -> Maybe Library -> Maybe Library
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) }) (Executable -> Executable) -> [Executable] -> [Executable]
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) }) (TestSuite -> TestSuite) -> [TestSuite] -> [TestSuite]
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) }) (Benchmark -> Benchmark) -> [Benchmark] -> [Benchmark]
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 =
([ExeName] -> Set ExeName
forall a. Ord a => [a] -> Set a
S.fromList ([ExeName] -> Set ExeName) -> [ExeName] -> Set ExeName
forall a b. (a -> b) -> a -> b
$ [[ExeName]] -> [ExeName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ExeName]]
unknowns, (DepValue -> DepValue -> DepValue)
-> [(PackageName, DepValue)] -> Map PackageName DepValue
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith DepValue -> DepValue -> DepValue
forall a. Semigroup a => a -> a -> a
(<>) ([(PackageName, DepValue)] -> Map PackageName DepValue)
-> [(PackageName, DepValue)] -> Map PackageName DepValue
forall a b. (a -> b) -> a -> b
$ [[(PackageName, DepValue)]] -> [(PackageName, DepValue)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(PackageName, DepValue)]]
knowns)
where
([[ExeName]]
unknowns, [[(PackageName, DepValue)]]
knowns) = [([ExeName], [(PackageName, DepValue)])]
-> ([[ExeName]], [[(PackageName, DepValue)]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([ExeName], [(PackageName, DepValue)])]
-> ([[ExeName]], [[(PackageName, DepValue)]]))
-> [([ExeName], [(PackageName, DepValue)])]
-> ([[ExeName]], [[(PackageName, DepValue)]])
forall a b. (a -> b) -> a -> b
$ (BuildInfo -> ([ExeName], [(PackageName, DepValue)]))
-> [BuildInfo] -> [([ExeName], [(PackageName, DepValue)])]
forall a b. (a -> b) -> [a] -> [b]
map BuildInfo -> ([ExeName], [(PackageName, DepValue)])
perBI ([BuildInfo] -> [([ExeName], [(PackageName, DepValue)])])
-> [BuildInfo] -> [([ExeName], [(PackageName, DepValue)])]
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) = [Either ExeName ExeDependency] -> ([ExeName], [ExeDependency])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ExeName ExeDependency] -> ([ExeName], [ExeDependency]))
-> [Either ExeName ExeDependency] -> ([ExeName], [ExeDependency])
forall a b. (a -> b) -> a -> b
$ (LegacyExeDependency -> Either ExeName ExeDependency)
-> [LegacyExeDependency] -> [Either ExeName ExeDependency]
forall a b. (a -> b) -> [a] -> [b]
map LegacyExeDependency -> Either ExeName ExeDependency
go1 (BuildInfo -> [LegacyExeDependency]
buildTools BuildInfo
bi)
tools :: [(PackageName, DepValue)]
tools = (ExeDependency -> Maybe (PackageName, DepValue))
-> [ExeDependency] -> [(PackageName, DepValue)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ExeDependency -> Maybe (PackageName, DepValue)
go2 ([ExeDependency]
knownTools [ExeDependency] -> [ExeDependency] -> [ExeDependency]
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 FilePath
name VersionRange
range) =
case FilePath -> Map FilePath PackageName -> Maybe PackageName
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
name Map FilePath PackageName
hardCodedMap of
Just PackageName
pkgName -> ExeDependency -> Either ExeName ExeDependency
forall a b. b -> Either a b
Right (ExeDependency -> Either ExeName ExeDependency)
-> ExeDependency -> Either ExeName ExeDependency
forall a b. (a -> b) -> a -> b
$ PackageName -> UnqualComponentName -> VersionRange -> ExeDependency
Cabal.ExeDependency PackageName
pkgName (FilePath -> UnqualComponentName
Cabal.mkUnqualComponentName FilePath
name) VersionRange
range
Maybe PackageName
Nothing -> ExeName -> Either ExeName ExeDependency
forall a b. a -> Either a b
Left (ExeName -> Either ExeName ExeDependency)
-> ExeName -> Either ExeName ExeDependency
forall a b. (a -> b) -> a -> b
$ Text -> ExeName
ExeName (Text -> ExeName) -> Text -> ExeName
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
name
go2 :: Cabal.ExeDependency -> Maybe (PackageName, DepValue)
go2 :: ExeDependency -> Maybe (PackageName, DepValue)
go2 (Cabal.ExeDependency PackageName
pkg UnqualComponentName
_name VersionRange
range)
| PackageName
pkg PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set PackageName
preInstalledPackages = Maybe (PackageName, DepValue)
forall a. Maybe a
Nothing
| Bool
otherwise = (PackageName, DepValue) -> Maybe (PackageName, DepValue)
forall a. a -> Maybe a
Just
( PackageName
pkg
, DepValue :: VersionRange -> DepType -> DepValue
DepValue
{ dvVersionRange :: VersionRange
dvVersionRange = VersionRange
range
, dvType :: DepType
dvType = DepType
AsBuildTool
}
)
hardCodedMap :: Map String D.PackageName
hardCodedMap :: Map FilePath PackageName
hardCodedMap = [(FilePath, PackageName)] -> Map FilePath PackageName
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (FilePath
"alex", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"alex")
, (FilePath
"happy", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"happy")
, (FilePath
"cpphs", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"cpphs")
, (FilePath
"greencard", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"greencard")
, (FilePath
"c2hs", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"c2hs")
, (FilePath
"hscolour", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"hscolour")
, (FilePath
"hspec-discover", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"hspec-discover")
, (FilePath
"hsx2hs", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"hsx2hs")
, (FilePath
"gtk2hsC2hs", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"gtk2hs-buildtools")
, (FilePath
"gtk2hsHookGenerator", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"gtk2hs-buildtools")
, (FilePath
"gtk2hsTypeGen", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"gtk2hs-buildtools")
]
preInstalledPackages :: Set D.PackageName
preInstalledPackages :: Set PackageName
preInstalledPackages = [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
S.fromList
[ FilePath -> PackageName
D.mkPackageName FilePath
"hsc2hs"
, FilePath -> PackageName
D.mkPackageName FilePath
"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 ]
[BuildInfo] -> [BuildInfo] -> [BuildInfo]
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 ]
[BuildInfo] -> [BuildInfo] -> [BuildInfo]
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 ]
[BuildInfo] -> [BuildInfo] -> [BuildInfo]
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 ]
[BuildInfo] -> [BuildInfo] -> [BuildInfo]
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) <-
RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
-> (Library
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning]))
-> Maybe Library
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
((Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return (Map NamedComponent (Map ModuleName (Path Abs File))
forall k a. Map k a
M.empty, Map NamedComponent [DotCabalPath]
forall k a. Map k a
M.empty, []))
((Library -> NamedComponent)
-> (NamedComponent
-> Library
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]))
-> Library
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
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
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) <-
([(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
-> (Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning]))
-> RIO
Ctx
[(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
[(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
-> (Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
forall a a a.
[(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
foldTuples
((Library
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning]))
-> [Library]
-> RIO
Ctx
[(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
((Library -> NamedComponent)
-> (NamedComponent
-> Library
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]))
-> Library
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
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) <-
([(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
-> (Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning]))
-> RIO
Ctx
[(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
[(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
-> (Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
forall a a a.
[(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
foldTuples
((Executable
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning]))
-> [Executable]
-> RIO
Ctx
[(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
((Executable -> NamedComponent)
-> (NamedComponent
-> Executable
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]))
-> Executable
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
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) <-
([(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
-> (Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning]))
-> RIO
Ctx
[(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
[(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
-> (Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
forall a a a.
[(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
foldTuples
((TestSuite
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning]))
-> [TestSuite]
-> RIO
Ctx
[(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((TestSuite -> NamedComponent)
-> (NamedComponent
-> TestSuite
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]))
-> TestSuite
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
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) <-
([(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
-> (Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning]))
-> RIO
Ctx
[(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
[(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
-> (Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
forall a a a.
[(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
foldTuples
((Benchmark
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning]))
-> [Benchmark]
-> RIO
Ctx
[(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
((Benchmark -> NamedComponent)
-> (NamedComponent
-> Benchmark
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]))
-> Benchmark
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], [PackageWarning])
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 <- Version -> [FilePath] -> RIO Ctx (Set (Path Abs File))
resolveGlobFiles (PackageDescription -> Version
specVersion PackageDescription
pkg)
(PackageDescription -> [FilePath]
extraSrcFiles PackageDescription
pkg
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (PackageDescription -> FilePath
dataDir PackageDescription
pkg FilePath -> FilePath -> FilePath
FilePath.</>) (PackageDescription -> [FilePath]
dataFiles PackageDescription
pkg))
let modules :: Map NamedComponent (Map ModuleName (Path Abs File))
modules = Map NamedComponent (Map ModuleName (Path Abs File))
libraryMods Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent (Map ModuleName (Path Abs File))
subLibrariesMods Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent (Map ModuleName (Path Abs File))
executableMods Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent (Map ModuleName (Path Abs File))
testMods Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent (Map ModuleName (Path Abs File))
benchModules
files :: Map NamedComponent [DotCabalPath]
files =
Map NamedComponent [DotCabalPath]
libDotCabalFiles Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent [DotCabalPath]
subLibDotCabalFiles Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent [DotCabalPath]
exeDotCabalFiles Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent [DotCabalPath]
testDotCabalFiles Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<>
Map NamedComponent [DotCabalPath]
benchDotCabalPaths
warnings :: [PackageWarning]
warnings = [PackageWarning]
libWarnings [PackageWarning] -> [PackageWarning] -> [PackageWarning]
forall a. Semigroup a => a -> a -> a
<> [PackageWarning]
subLibWarnings [PackageWarning] -> [PackageWarning] -> [PackageWarning]
forall a. Semigroup a => a -> a -> a
<> [PackageWarning]
exeWarnings [PackageWarning] -> [PackageWarning] -> [PackageWarning]
forall a. Semigroup a => a -> a -> a
<> [PackageWarning]
testWarnings [PackageWarning] -> [PackageWarning] -> [PackageWarning]
forall a. Semigroup a => a -> a -> a
<> [PackageWarning]
benchWarnings
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
-> RIO
Ctx
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
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 = NamedComponent -> b -> NamedComponent
forall a b. a -> b -> a
const NamedComponent
CLib
internalLibComponent :: Library -> NamedComponent
internalLibComponent = Text -> NamedComponent
CInternalLib (Text -> NamedComponent)
-> (Library -> Text) -> Library -> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (Library -> FilePath) -> Library -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> (UnqualComponentName -> FilePath)
-> Maybe UnqualComponentName
-> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (Maybe UnqualComponentName -> FilePath)
-> (Library -> Maybe UnqualComponentName) -> Library -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LibraryName -> Maybe UnqualComponentName
libraryNameString (LibraryName -> Maybe UnqualComponentName)
-> (Library -> LibraryName) -> Library -> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName
exeComponent :: Executable -> NamedComponent
exeComponent = Text -> NamedComponent
CExe (Text -> NamedComponent)
-> (Executable -> Text) -> Executable -> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text)
-> (Executable -> FilePath) -> Executable -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> FilePath)
-> (Executable -> UnqualComponentName) -> Executable -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> UnqualComponentName
exeName
testComponent :: TestSuite -> NamedComponent
testComponent = Text -> NamedComponent
CTest (Text -> NamedComponent)
-> (TestSuite -> Text) -> TestSuite -> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (TestSuite -> FilePath) -> TestSuite -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> FilePath)
-> (TestSuite -> UnqualComponentName) -> TestSuite -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> UnqualComponentName
testName
benchComponent :: Benchmark -> NamedComponent
benchComponent = Text -> NamedComponent
CBench (Text -> NamedComponent)
-> (Benchmark -> Text) -> Benchmark -> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (Benchmark -> FilePath) -> Benchmark -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> FilePath)
-> (Benchmark -> UnqualComponentName) -> Benchmark -> FilePath
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
(Map k a, Map k a, c) -> m (Map k a, Map k a, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (k -> a -> Map k a
forall k a. k -> a -> Map k a
M.singleton (t -> k
label t
lib) a
a, k -> a -> Map k 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 = ((Map NamedComponent a, Map NamedComponent a, [a])
-> (Map NamedComponent a, Map NamedComponent a, [a])
-> (Map NamedComponent a, Map NamedComponent a, [a]))
-> (Map NamedComponent a, Map NamedComponent a, [a])
-> [(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map NamedComponent a, Map NamedComponent a, [a])
-> (Map NamedComponent a, Map NamedComponent a, [a])
-> (Map NamedComponent a, Map NamedComponent a, [a])
forall a. Semigroup a => a -> a -> a
(<>) (Map NamedComponent a
forall k a. Map k a
M.empty, Map NamedComponent a
forall k a. Map k a
M.empty, [])
resolveGlobFiles
:: Version
-> [String]
-> RIO Ctx (Set (Path Abs File))
resolveGlobFiles :: Version -> [FilePath] -> RIO Ctx (Set (Path Abs File))
resolveGlobFiles Version
cabalFileVersion =
([[Maybe (Path Abs File)]] -> Set (Path Abs File))
-> RIO Ctx [[Maybe (Path Abs File)]]
-> RIO Ctx (Set (Path Abs File))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Path Abs File] -> Set (Path Abs File)
forall a. Ord a => [a] -> Set a
S.fromList ([Path Abs File] -> Set (Path Abs File))
-> ([[Maybe (Path Abs File)]] -> [Path Abs File])
-> [[Maybe (Path Abs File)]]
-> Set (Path Abs File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Path Abs File)] -> [Path Abs File]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Path Abs File)] -> [Path Abs File])
-> ([[Maybe (Path Abs File)]] -> [Maybe (Path Abs File)])
-> [[Maybe (Path Abs File)]]
-> [Path Abs File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Maybe (Path Abs File)]] -> [Maybe (Path Abs File)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (RIO Ctx [[Maybe (Path Abs File)]]
-> RIO Ctx (Set (Path Abs File)))
-> ([FilePath] -> RIO Ctx [[Maybe (Path Abs File)]])
-> [FilePath]
-> RIO Ctx (Set (Path Abs File))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(FilePath -> RIO Ctx [Maybe (Path Abs File)])
-> [FilePath] -> RIO Ctx [[Maybe (Path Abs File)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> RIO Ctx [Maybe (Path Abs File)]
resolve
where
resolve :: FilePath -> RIO Ctx [Maybe (Path Abs File)]
resolve FilePath
name =
if Char
'*' Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
name
then FilePath -> RIO Ctx [Maybe (Path Abs File)]
explode FilePath
name
else (Maybe (Path Abs File) -> [Maybe (Path Abs File)])
-> RIO Ctx (Maybe (Path Abs File))
-> RIO Ctx [Maybe (Path Abs File)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Maybe (Path Abs File) -> [Maybe (Path Abs File)]
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> RIO Ctx (Maybe (Path Abs File))
resolveFileOrWarn FilePath
name)
explode :: FilePath -> RIO Ctx [Maybe (Path Abs File)]
explode FilePath
name = do
Path Abs Dir
dir <- (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir)
-> (Ctx -> Path Abs File) -> Ctx -> Path Abs Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
[FilePath]
names <-
FilePath -> FilePath -> RIO Ctx [FilePath]
forall (m :: * -> *) env.
(MonadUnliftIO m, HasTerm env, MonadReader env m) =>
FilePath -> FilePath -> m [FilePath]
matchDirFileGlob'
(Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
FL.toFilePath Path Abs Dir
dir)
FilePath
name
(FilePath -> RIO Ctx (Maybe (Path Abs File)))
-> [FilePath] -> RIO Ctx [Maybe (Path Abs File)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> RIO Ctx (Maybe (Path Abs File))
resolveFileOrWarn [FilePath]
names
matchDirFileGlob' :: FilePath -> FilePath -> m [FilePath]
matchDirFileGlob' FilePath
dir FilePath
glob =
m [FilePath] -> (IOException -> m [FilePath]) -> m [FilePath]
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
(IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Verbosity -> Version -> FilePath -> FilePath -> IO [FilePath]
matchDirFileGlob Verbosity
forall a. Bounded a => a
minBound Version
cabalFileVersion FilePath
dir FilePath
glob))
(\(IOException
e :: IOException) ->
if IOException -> Bool
isUserError IOException
e
then do
[StyleDoc] -> m ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ FilePath -> StyleDoc
flow FilePath
"Wildcard does not match any files:"
, Style -> StyleDoc -> StyleDoc
style Style
File (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
glob
, StyleDoc
line StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> FilePath -> StyleDoc
flow FilePath
"in directory:"
, Style -> StyleDoc -> StyleDoc
style Style
Dir (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
dir
]
[FilePath] -> m [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else IOException -> m [FilePath]
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 [DotCabalDescriptor]
-> [DotCabalDescriptor] -> [DotCabalDescriptor]
forall a. Semigroup a => a -> a -> a
<> [DotCabalDescriptor]
exposed
exposed :: [DotCabalDescriptor]
exposed =
case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bench of
BenchmarkExeV10 Version
_ FilePath
fp -> [FilePath -> DotCabalDescriptor
DotCabalMain FilePath
fp]
BenchmarkUnsupported BenchmarkType
_ -> []
bnames :: [DotCabalDescriptor]
bnames = (ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
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 [DotCabalDescriptor]
-> [DotCabalDescriptor] -> [DotCabalDescriptor]
forall a. Semigroup a => a -> a -> a
<> [DotCabalDescriptor]
exposed
exposed :: [DotCabalDescriptor]
exposed =
case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
TestSuiteExeV10 Version
_ FilePath
fp -> [FilePath -> DotCabalDescriptor
DotCabalMain FilePath
fp]
TestSuiteLibV09 Version
_ ModuleName
mn -> [ModuleName -> DotCabalDescriptor
DotCabalModule ModuleName
mn]
TestSuiteUnsupported TestType
_ -> []
bnames :: [DotCabalDescriptor]
bnames = (ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
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 =
(ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (BuildInfo -> [ModuleName]
otherModules BuildInfo
build) [DotCabalDescriptor]
-> [DotCabalDescriptor] -> [DotCabalDescriptor]
forall a. [a] -> [a] -> [a]
++
[FilePath -> DotCabalDescriptor
DotCabalMain (Executable -> FilePath
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 [DotCabalDescriptor]
-> [DotCabalDescriptor] -> [DotCabalDescriptor]
forall a. [a] -> [a] -> [a]
++ [DotCabalDescriptor]
exposed
exposed :: [DotCabalDescriptor]
exposed = (ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (Library -> [ModuleName]
exposedModules Library
lib)
bnames :: [DotCabalDescriptor]
bnames = (ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
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 <- (FilePath -> RIO Ctx (Maybe (Path Abs Dir)))
-> [FilePath] -> RIO Ctx [Path Abs Dir]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM FilePath -> RIO Ctx (Maybe (Path Abs Dir))
resolveDirOrWarn (BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
build)
Path Abs Dir
dir <- (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir)
-> (Ctx -> Path Abs File) -> Ctx -> Path Abs Dir
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 [Path Abs Dir] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path Abs Dir]
dirs then [Path Abs Dir
dir] else [Path Abs Dir]
dirs) [Path Abs Dir] -> [Path Abs Dir] -> [Path Abs Dir]
forall a. [a] -> [a] -> [a]
++ [Path Abs Dir]
agdirs)
[DotCabalDescriptor]
names
[DotCabalPath]
cfiles <- BuildInfo -> RIO Ctx [DotCabalPath]
buildOtherSources BuildInfo
build
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return (Map ModuleName (Path Abs File)
modules, [DotCabalPath]
files [DotCabalPath] -> [DotCabalPath] -> [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> [DotCabalPath]
cfiles, [PackageWarning]
warnings)
where
autogenDirs :: RIO Ctx [Path Abs Dir]
autogenDirs = do
Version
cabalVer <- (Ctx -> Version) -> RIO Ctx Version
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Version
ctxCabalVer
Path Abs Dir
distDir <- (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
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 = Maybe (Path Abs Dir) -> [Path Abs Dir]
forall a. Maybe a -> [a]
maybeToList (Maybe (Path Abs Dir) -> [Path Abs Dir])
-> Maybe (Path Abs Dir) -> [Path Abs Dir]
forall a b. (a -> b) -> a -> b
$ Version -> Path Abs Dir -> Maybe (Path Abs Dir)
packageAutogenDir Version
cabalVer Path Abs Dir
distDir
(Path Abs Dir -> RIO Ctx Bool)
-> [Path Abs Dir] -> RIO Ctx [Path Abs Dir]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Path Abs Dir -> RIO Ctx Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist ([Path Abs Dir] -> RIO Ctx [Path Abs Dir])
-> [Path Abs Dir] -> RIO Ctx [Path Abs Dir]
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
compDir Path Abs Dir -> [Path Abs Dir] -> [Path Abs Dir]
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 <- IO (Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
Path Abs Dir
dir <- (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir)
-> (Ctx -> Path Abs File) -> Ctx -> Path Abs Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
Path Abs File
file <- (Ctx -> Path Abs File) -> RIO Ctx (Path Abs File)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Path Abs File
ctxFile
let resolveDirFiles :: [FilePath] -> (Path Abs File -> b) -> RIO Ctx [b]
resolveDirFiles [FilePath]
files Path Abs File -> b
toCabalPath =
[FilePath] -> (FilePath -> RIO Ctx (Maybe b)) -> RIO Ctx [b]
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM [FilePath]
files ((FilePath -> RIO Ctx (Maybe b)) -> RIO Ctx [b])
-> (FilePath -> RIO Ctx (Maybe b)) -> RIO Ctx [b]
forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> do
Maybe (Path Abs File)
result <- Path Abs Dir -> FilePath -> RIO Ctx (Maybe (Path Abs File))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
resolveDirFile Path Abs Dir
dir FilePath
fp
case Maybe (Path Abs File)
result of
Maybe (Path Abs File)
Nothing -> do
Text -> Path Abs Dir -> FilePath -> Path Abs File -> RIO Ctx ()
warnMissingFile Text
"File" Path Abs Dir
cwd FilePath
fp Path Abs File
file
Maybe b -> RIO Ctx (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
Just Path Abs File
p -> Maybe b -> RIO Ctx (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> RIO Ctx (Maybe b)) -> Maybe b -> RIO Ctx (Maybe b)
forall a b. (a -> b) -> a -> b
$ b -> Maybe b
forall a. a -> Maybe a
Just (Path Abs File -> b
toCabalPath Path Abs File
p)
[DotCabalPath]
csources <- [FilePath]
-> (Path Abs File -> DotCabalPath) -> RIO Ctx [DotCabalPath]
forall b. [FilePath] -> (Path Abs File -> b) -> RIO Ctx [b]
resolveDirFiles (BuildInfo -> [FilePath]
cSources BuildInfo
build) Path Abs File -> DotCabalPath
DotCabalCFilePath
[DotCabalPath]
jsources <- [FilePath]
-> (Path Abs File -> DotCabalPath) -> RIO Ctx [DotCabalPath]
forall b. [FilePath] -> (Path Abs File -> b) -> RIO Ctx [b]
resolveDirFiles (BuildInfo -> [FilePath]
targetJsSources BuildInfo
build) Path Abs File -> DotCabalPath
DotCabalFilePath
[DotCabalPath] -> RIO Ctx [DotCabalPath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([DotCabalPath]
csources [DotCabalPath] -> [DotCabalPath] -> [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> [DotCabalPath]
jsources)
targetJsSources :: BuildInfo -> [FilePath]
targetJsSources :: BuildInfo -> [FilePath]
targetJsSources = BuildInfo -> [FilePath]
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 [Flag]
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 :: PackageDescription -> PackageDescription -> PackageDescriptionPair
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 =
(CondTree ConfVar [Dependency] Library -> Library)
-> Maybe (CondTree ConfVar [Dependency] Library) -> Maybe Library
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ResolveConditions
-> (Library -> [Dependency] -> Library)
-> CondTree ConfVar [Dependency] Library
-> Library
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 =
((UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [Library]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n, CondTree ConfVar [Dependency] Library
v) -> (ResolveConditions
-> (Library -> [Dependency] -> Library)
-> CondTree ConfVar [Dependency] Library
-> Library
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 =
((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> ForeignLib)
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] ForeignLib)]
-> [ForeignLib]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n, CondTree ConfVar [Dependency] ForeignLib
v) -> (ResolveConditions
-> (ForeignLib -> [Dependency] -> ForeignLib)
-> CondTree ConfVar [Dependency] ForeignLib
-> ForeignLib
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 =
((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Executable)
-> [(UnqualComponentName,
CondTree ConfVar [Dependency] Executable)]
-> [Executable]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n, CondTree ConfVar [Dependency] Executable
v) -> (ResolveConditions
-> (Executable -> [Dependency] -> Executable)
-> CondTree ConfVar [Dependency] Executable
-> Executable
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 =
((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> TestSuite)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [TestSuite]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n,CondTree ConfVar [Dependency] TestSuite
v) -> (ResolveConditions
-> (TestSuite -> [Dependency] -> TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
-> TestSuite
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 =
((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Benchmark)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [Benchmark]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n,CondTree ConfVar [Dependency] Benchmark
v) -> (ResolveConditions
-> (Benchmark -> [Dependency] -> Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
-> Benchmark
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 =
Map FlagName Bool -> Map FlagName Bool -> Map FlagName Bool
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (PackageConfig -> Map FlagName Bool
packageConfigFlags PackageConfig
packageConfig)
([Flag] -> Map FlagName Bool
flagMap [Flag]
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 :: [Flag] -> Map FlagName Bool
flagMap :: [Flag] -> Map FlagName Bool
flagMap = [(FlagName, Bool)] -> Map FlagName Bool
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(FlagName, Bool)] -> Map FlagName Bool)
-> ([Flag] -> [(FlagName, Bool)]) -> [Flag] -> Map FlagName Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Flag -> (FlagName, Bool)) -> [Flag] -> [(FlagName, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map Flag -> (FlagName, Bool)
pair
where pair :: Flag -> (FlagName, Bool)
pair :: Flag -> (FlagName, Bool)
pair = Flag -> FlagName
flagName (Flag -> FlagName) -> (Flag -> Bool) -> Flag -> (FlagName, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Flag -> 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 :: Map FlagName Bool
-> ActualCompiler -> OS -> Arch -> ResolveConditions
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 :: 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 target -> target -> target
forall a. Semigroup a => a -> a -> a
<> target
children
where basic :: target
basic = target -> cs -> target
addDeps target
lib cs
deps
children :: target
children = [target] -> target
forall a. Monoid a => [a] -> a
mconcat ((CondBranch ConfVar cs target -> target)
-> [CondBranch ConfVar cs target] -> [target]
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 ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
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 target
-> (CondTree ConfVar cs target -> target)
-> Maybe (CondTree ConfVar cs target)
-> target
forall b a. b -> (a -> b) -> Maybe a -> b
maybe target
forall a. Monoid a => a
mempty (ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
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
varSatisifed 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
varSatisifed :: ConfVar -> Bool
varSatisifed ConfVar
v =
case ConfVar
v of
OS OS
os -> OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== ResolveConditions -> OS
rcOS ResolveConditions
rc
Arch Arch
arch -> Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== ResolveConditions -> Arch
rcArch ResolveConditions
rc
Flag FlagName
flag ->
Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FlagName -> Map FlagName Bool -> Maybe Bool
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 Set ModuleName
forall a. Set a
S.empty
[PackageWarning]
warnings <- ([PackageWarning] -> [PackageWarning] -> [PackageWarning])
-> RIO Ctx [PackageWarning]
-> RIO Ctx [PackageWarning]
-> RIO Ctx [PackageWarning]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [PackageWarning] -> [PackageWarning] -> [PackageWarning]
forall a. [a] -> [a] -> [a]
(++) (Map ModuleName (Path Abs File) -> RIO Ctx [PackageWarning]
forall (m :: * -> *) b.
Monad m =>
Map ModuleName b -> m [PackageWarning]
warnUnlisted Map ModuleName (Path Abs File)
foundModules) ([ModuleName] -> RIO Ctx [PackageWarning]
forall (m :: * -> *) p a. Monad m => p -> m [a]
warnMissing [ModuleName]
missingModules)
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
-> RIO
Ctx
(Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
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
_ = ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
-> RIO
Ctx ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Map ModuleName (Path Abs File)
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 = ((DotCabalDescriptor, Maybe DotCabalPath) -> Maybe DotCabalPath)
-> [(DotCabalDescriptor, Maybe DotCabalPath)] -> [DotCabalPath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DotCabalDescriptor, Maybe DotCabalPath) -> Maybe DotCabalPath
forall a b. (a, b) -> b
snd [(DotCabalDescriptor, Maybe DotCabalPath)]
resolved
foundModules :: [(ModuleName, Path Abs File)]
foundModules = ((DotCabalDescriptor, Maybe DotCabalPath)
-> Maybe (ModuleName, Path Abs File))
-> [(DotCabalDescriptor, Maybe DotCabalPath)]
-> [(ModuleName, Path Abs File)]
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 = ((DotCabalDescriptor, Maybe DotCabalPath) -> Maybe ModuleName)
-> [(DotCabalDescriptor, Maybe DotCabalPath)] -> [ModuleName]
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 <- (DotCabalPath -> RIO Ctx (Set ModuleName, [Path Abs File]))
-> [DotCabalPath] -> RIO Ctx [(Set ModuleName, [Path Abs File])]
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 =
Set ModuleName -> Set ModuleName -> Set ModuleName
forall a. Ord a => Set a -> Set a -> Set a
S.union
Set ModuleName
doneModules0
([ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
S.fromList ((DotCabalDescriptor -> Maybe ModuleName)
-> [DotCabalDescriptor] -> [ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DotCabalDescriptor -> Maybe ModuleName
dotCabalModule [DotCabalDescriptor]
names))
moduleDeps :: Set ModuleName
moduleDeps = [Set ModuleName] -> Set ModuleName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (((Set ModuleName, [Path Abs File]) -> Set ModuleName)
-> [(Set ModuleName, [Path Abs File])] -> [Set ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (Set ModuleName, [Path Abs File]) -> Set ModuleName
forall a b. (a, b) -> a
fst [(Set ModuleName, [Path Abs File])]
pairs)
thDepFiles :: [Path Abs File]
thDepFiles = ((Set ModuleName, [Path Abs File]) -> [Path Abs File])
-> [(Set ModuleName, [Path Abs File])] -> [Path Abs File]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Set ModuleName, [Path Abs File]) -> [Path Abs File]
forall a b. (a, b) -> b
snd [(Set ModuleName, [Path Abs File])]
pairs
modulesRemaining :: Set ModuleName
modulesRemaining = Set ModuleName -> Set ModuleName -> Set ModuleName
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 ((ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (Set ModuleName -> [ModuleName]
forall a. Set a -> [a]
S.toList Set ModuleName
modulesRemaining)) Set ModuleName
doneModules
([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
-> RIO
Ctx ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
forall (m :: * -> *) a. Monad m => a -> m a
return
( [DotCabalPath] -> [DotCabalPath]
forall a. Ord a => [a] -> [a]
nubOrd ([DotCabalPath] -> [DotCabalPath])
-> [DotCabalPath] -> [DotCabalPath]
forall a b. (a -> b) -> a -> b
$ [DotCabalPath]
foundFiles [DotCabalPath] -> [DotCabalPath] -> [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> (Path Abs File -> DotCabalPath)
-> [Path Abs File] -> [DotCabalPath]
forall a b. (a -> b) -> [a] -> [b]
map Path Abs File -> DotCabalPath
DotCabalFilePath [Path Abs File]
thDepFiles [DotCabalPath] -> [DotCabalPath] -> [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> [DotCabalPath]
resolvedFiles
, Map ModuleName (Path Abs File)
-> Map ModuleName (Path Abs File) -> Map ModuleName (Path Abs File)
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union
([(ModuleName, Path Abs File)] -> Map ModuleName (Path Abs File)
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 Map ModuleName b -> Map ModuleName () -> Map ModuleName b
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference`
[(ModuleName, ())] -> Map ModuleName ()
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((DotCabalDescriptor -> Maybe (ModuleName, ()))
-> [DotCabalDescriptor] -> [(ModuleName, ())]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((ModuleName -> (ModuleName, ()))
-> Maybe ModuleName -> Maybe (ModuleName, ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ()) (Maybe ModuleName -> Maybe (ModuleName, ()))
-> (DotCabalDescriptor -> Maybe ModuleName)
-> DotCabalDescriptor
-> Maybe (ModuleName, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCabalDescriptor -> Maybe ModuleName
dotCabalModule) [DotCabalDescriptor]
names0)
[PackageWarning] -> m [PackageWarning]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageWarning] -> m [PackageWarning])
-> [PackageWarning] -> m [PackageWarning]
forall a b. (a -> b) -> a -> b
$
if Map ModuleName b -> Bool
forall k a. Map k a -> Bool
M.null Map ModuleName b
unlistedModules
then []
else [ NamedComponent -> [ModuleName] -> PackageWarning
UnlistedModulesWarning
NamedComponent
component
(((ModuleName, b) -> ModuleName)
-> [(ModuleName, b)] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, b) -> ModuleName
forall a b. (a, b) -> a
fst (Map ModuleName b -> [(ModuleName, b)]
forall k a. Map k a -> [(k, a)]
M.toList Map ModuleName b
unlistedModules))]
warnMissing :: p -> m [a]
warnMissing p
_missingModules = do
[a] -> m [a]
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)) =
(ModuleName, Path Abs File) -> Maybe (ModuleName, Path Abs File)
forall a. a -> Maybe a
Just (ModuleName
mn, Path Abs File
fp)
toResolvedModule (DotCabalDescriptor, Maybe DotCabalPath)
_ =
Maybe (ModuleName, Path Abs File)
forall a. Maybe a
Nothing
toMissingModule
:: (DotCabalDescriptor, Maybe DotCabalPath)
-> Maybe ModuleName
toMissingModule :: (DotCabalDescriptor, Maybe DotCabalPath) -> Maybe ModuleName
toMissingModule (DotCabalModule ModuleName
mn, Maybe DotCabalPath
Nothing) =
ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
mn
toMissingModule (DotCabalDescriptor, Maybe DotCabalPath)
_ =
Maybe ModuleName
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 -> Path Abs File -> RIO Ctx (Set ModuleName, [Path Abs File])
forall t. Path Abs t -> RIO Ctx (Set ModuleName, [Path Abs File])
readResolvedHi Path Abs File
resolvedFile
DotCabalMainPath Path Abs File
resolvedFile -> Path Abs File -> RIO Ctx (Set ModuleName, [Path Abs File])
forall t. Path Abs t -> RIO Ctx (Set ModuleName, [Path Abs File])
readResolvedHi Path Abs File
resolvedFile
DotCabalFilePath{} -> (Set ModuleName, [Path Abs File])
-> RIO Ctx (Set ModuleName, [Path Abs File])
forall (m :: * -> *) a. Monad m => a -> m a
return (Set ModuleName
forall a. Set a
S.empty, [])
DotCabalCFilePath{} -> (Set ModuleName, [Path Abs File])
-> RIO Ctx (Set ModuleName, [Path Abs File])
forall (m :: * -> *) a. Monad m => a -> m a
return (Set ModuleName
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 (Path Abs Dir -> Path Abs Dir)
-> RIO Ctx (Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Path Abs Dir
ctxDistDir
Path Abs Dir
dir <- (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir)
-> (Ctx -> Path Abs File) -> Ctx -> Path Abs Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
let sourceDir :: Path Abs Dir
sourceDir = Path Abs Dir -> Maybe (Path Abs Dir) -> Path Abs Dir
forall a. a -> Maybe a -> a
fromMaybe Path Abs Dir
dir (Maybe (Path Abs Dir) -> Path Abs Dir)
-> Maybe (Path Abs Dir) -> Path Abs Dir
forall a b. (a -> b) -> a -> b
$ (Path Abs Dir -> Bool) -> [Path Abs Dir] -> Maybe (Path Abs Dir)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Path Abs Dir -> Path Abs t -> Bool
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 = Path Abs Dir -> Path Abs t -> m (Path Rel t)
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 Path Abs Dir -> Maybe (Path Rel t)
forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir -> m (Path Rel t)
stripSourceDir Path Abs Dir
sourceDir of
Maybe (Path Rel t)
Nothing -> (Set ModuleName, [Path Abs File])
-> RIO Ctx (Set ModuleName, [Path Abs File])
forall (m :: * -> *) a. Monad m => a -> m a
return (Set ModuleName
forall a. Set a
S.empty, [])
Just Path Rel t
fileRel -> do
let hiPath :: FilePath
hiPath =
FilePath -> FilePath -> FilePath
FilePath.replaceExtension
(Path Abs t -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Abs Dir
dumpHIDir Path Abs Dir -> Path Rel t -> Path Abs t
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel t
fileRel))
FilePath
".hi"
Bool
dumpHIExists <- IO Bool -> RIO Ctx Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> RIO Ctx Bool) -> IO Bool -> RIO Ctx Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
D.doesFileExist FilePath
hiPath
if Bool
dumpHIExists
then FilePath -> RIO Ctx (Set ModuleName, [Path Abs File])
parseHI FilePath
hiPath
else (Set ModuleName, [Path Abs File])
-> RIO Ctx (Set ModuleName, [Path Abs File])
forall (m :: * -> *) a. Monad m => a -> m a
return (Set ModuleName
forall a. Set a
S.empty, [])
parseHI
:: FilePath -> RIO Ctx (Set ModuleName, [Path Abs File])
parseHI :: FilePath -> RIO Ctx (Set ModuleName, [Path Abs File])
parseHI FilePath
hiPath = do
Path Abs Dir
dir <- (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir)
-> (Ctx -> Path Abs File) -> Ctx -> Path Abs Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
Either FilePath Interface
result <- IO (Either FilePath Interface)
-> RIO Ctx (Either FilePath Interface)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either FilePath Interface)
-> RIO Ctx (Either FilePath Interface))
-> IO (Either FilePath Interface)
-> RIO Ctx (Either FilePath Interface)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either FilePath Interface)
Iface.fromFile FilePath
hiPath
case Either FilePath Interface
result of
Left FilePath
msg -> do
[StyleDoc] -> RIO Ctx ()
forall env. HasConfig env => [StyleDoc] -> RIO env ()
prettyStackDevL
[ FilePath -> StyleDoc
flow FilePath
"Failed to decode module interface:"
, Style -> StyleDoc -> StyleDoc
style Style
File (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
hiPath
, FilePath -> StyleDoc
flow FilePath
"Decoding failure:"
, Style -> StyleDoc -> StyleDoc
style Style
Error (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
msg
]
(Set ModuleName, [Path Abs File])
-> RIO Ctx (Set ModuleName, [Path Abs File])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set ModuleName
forall a. Set a
S.empty, [])
Right Interface
iface -> do
let moduleNames :: Interface -> [ModuleName]
moduleNames = ((ByteString, Bool) -> ModuleName)
-> [(ByteString, Bool)] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> ModuleName
forall a. IsString a => FilePath -> a
fromString (FilePath -> ModuleName)
-> ((ByteString, Bool) -> FilePath)
-> (ByteString, Bool)
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath)
-> ((ByteString, Bool) -> Text) -> (ByteString, Bool) -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8Lenient (ByteString -> Text)
-> ((ByteString, Bool) -> ByteString) -> (ByteString, Bool) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, Bool) -> ByteString
forall a b. (a, b) -> a
fst) ([(ByteString, Bool)] -> [ModuleName])
-> (Interface -> [(ByteString, Bool)]) -> Interface -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
List (ByteString, Bool) -> [(ByteString, Bool)]
forall a. List a -> [a]
Iface.unList (List (ByteString, Bool) -> [(ByteString, Bool)])
-> (Interface -> List (ByteString, Bool))
-> Interface
-> [(ByteString, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> List (ByteString, Bool)
Iface.dmods (Dependencies -> List (ByteString, Bool))
-> (Interface -> Dependencies)
-> Interface
-> List (ByteString, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> Dependencies
Iface.deps
resolveFileDependency :: FilePath -> m (Maybe (Path Abs File))
resolveFileDependency FilePath
file = do
Maybe (Path Abs File)
resolved <- IO (Maybe (Path Abs File)) -> m (Maybe (Path Abs File))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Abs File) -> IO (Maybe (Path Abs File))
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (Path Abs Dir -> FilePath -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Path Abs File)
resolveFile Path Abs Dir
dir FilePath
file)) m (Maybe (Path Abs File))
-> (Maybe (Path Abs File) -> m (Maybe (Path Abs File)))
-> m (Maybe (Path Abs File))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Path Abs File) -> m (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs File) -> m (Maybe (Path Abs File))
rejectMissingFile
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Path Abs File) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Path Abs File)
resolved) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
[StyleDoc] -> m ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ FilePath -> StyleDoc
flow FilePath
"Dependent file listed in:"
, Style -> StyleDoc -> StyleDoc
style Style
File (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
hiPath
, FilePath -> StyleDoc
flow FilePath
"does not exist:"
, Style -> StyleDoc -> StyleDoc
style Style
File (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
file
]
Maybe (Path Abs File) -> m (Maybe (Path Abs File))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs File)
resolved
resolveUsages :: Interface -> RIO Ctx [Maybe (Path Abs File)]
resolveUsages = (Usage -> RIO Ctx (Maybe (Path Abs File)))
-> [Usage] -> RIO Ctx [Maybe (Path Abs File)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FilePath -> RIO Ctx (Maybe (Path Abs File))
forall (m :: * -> *) env.
(MonadIO m, HasTerm env, MonadReader env m) =>
FilePath -> m (Maybe (Path Abs File))
resolveFileDependency (FilePath -> RIO Ctx (Maybe (Path Abs File)))
-> (Usage -> FilePath) -> Usage -> RIO Ctx (Maybe (Path Abs File))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Usage -> FilePath
Iface.unUsage) ([Usage] -> RIO Ctx [Maybe (Path Abs File)])
-> (Interface -> [Usage])
-> Interface
-> RIO Ctx [Maybe (Path Abs File)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List Usage -> [Usage]
forall a. List a -> [a]
Iface.unList (List Usage -> [Usage])
-> (Interface -> List Usage) -> Interface -> [Usage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> List Usage
Iface.usage
[Path Abs File]
resolvedUsages <- [Maybe (Path Abs File)] -> [Path Abs File]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Path Abs File)] -> [Path Abs File])
-> RIO Ctx [Maybe (Path Abs File)] -> RIO Ctx [Path Abs File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Interface -> RIO Ctx [Maybe (Path Abs File)]
resolveUsages Interface
iface
(Set ModuleName, [Path Abs File])
-> RIO Ctx (Set ModuleName, [Path Abs File])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
S.fromList ([ModuleName] -> Set ModuleName) -> [ModuleName] -> Set ModuleName
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 =
[DotCabalDescriptor]
-> (DotCabalDescriptor
-> RIO Ctx (DotCabalDescriptor, Maybe DotCabalPath))
-> RIO Ctx [(DotCabalDescriptor, Maybe DotCabalPath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [DotCabalDescriptor]
names (\DotCabalDescriptor
name -> (Maybe DotCabalPath -> (DotCabalDescriptor, Maybe DotCabalPath))
-> RIO Ctx (Maybe DotCabalPath)
-> RIO Ctx (DotCabalDescriptor, Maybe DotCabalPath)
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 -> FilePath
show (CabalFileNameParseFail FilePath
fp) = FilePath
"Invalid file path for cabal file, must have a .cabal extension: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fp
show (CabalFileNameInvalidPackageName FilePath
fp) = FilePath
"cabal file names must use valid package names followed by a .cabal extension, the following is invalid: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fp
parsePackageNameFromFilePath :: MonadThrow m => Path a File -> m PackageName
parsePackageNameFromFilePath :: Path a File -> m PackageName
parsePackageNameFromFilePath Path a File
fp = do
FilePath
base <- FilePath -> m FilePath
clean (FilePath -> m FilePath) -> FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Rel File -> FilePath) -> Path Rel File -> FilePath
forall a b. (a -> b) -> a -> b
$ Path a File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path a File
fp
case FilePath -> Maybe PackageName
parsePackageName FilePath
base of
Maybe PackageName
Nothing -> CabalFileNameParseFail -> m PackageName
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CabalFileNameParseFail -> m PackageName)
-> CabalFileNameParseFail -> m PackageName
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalFileNameParseFail
CabalFileNameInvalidPackageName (FilePath -> CabalFileNameParseFail)
-> FilePath -> CabalFileNameParseFail
forall a b. (a -> b) -> a -> b
$ Path a File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path a File
fp
Just PackageName
x -> PackageName -> m PackageName
forall (m :: * -> *) a. Monad m => a -> m a
return PackageName
x
where clean :: FilePath -> m FilePath
clean = (FilePath -> FilePath) -> m FilePath -> m FilePath
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM FilePath -> FilePath
forall a. [a] -> [a]
reverse (m FilePath -> m FilePath)
-> (FilePath -> m FilePath) -> FilePath -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m FilePath
forall (m :: * -> *). MonadThrow m => FilePath -> m FilePath
strip (FilePath -> m FilePath)
-> (FilePath -> FilePath) -> FilePath -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse
strip :: FilePath -> m FilePath
strip (Char
'l':Char
'a':Char
'b':Char
'a':Char
'c':Char
'.':FilePath
xs) = FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
xs
strip FilePath
_ = CabalFileNameParseFail -> m FilePath
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> CabalFileNameParseFail
CabalFileNameParseFail (Path a File -> FilePath
forall b t. Path b t -> FilePath
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 <- (Ctx -> Path Abs File) -> RIO Ctx (Path Abs File)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Path Abs File
ctxFile RIO Ctx (Path Abs File)
-> (Path Abs File -> RIO Ctx PackageName) -> RIO Ctx PackageName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path Abs File -> RIO Ctx PackageName
forall (m :: * -> *) a.
MonadThrow m =>
Path a File -> m PackageName
parsePackageNameFromFilePath
[Path Abs File]
candidates <- IO [Path Abs File] -> RIO Ctx [Path Abs File]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Path Abs File]
makeNameCandidates
case [Path Abs File]
candidates of
[Path Abs File
candidate] -> Maybe DotCabalPath -> RIO Ctx (Maybe DotCabalPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (DotCabalPath -> Maybe DotCabalPath
forall a. a -> Maybe a
Just (Path Abs File -> DotCabalPath
cons Path Abs File
candidate))
[] -> do
case DotCabalDescriptor
name of
DotCabalModule ModuleName
mn
| ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
D.display ModuleName
mn FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageName -> FilePath
paths_pkg PackageName
pkg -> [Path Abs Dir] -> ModuleName -> RIO Ctx ()
forall env.
HasTerm env =>
[Path Abs Dir] -> ModuleName -> RIO env ()
logPossibilities [Path Abs Dir]
dirs ModuleName
mn
DotCabalDescriptor
_ -> () -> RIO Ctx ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe DotCabalPath -> RIO Ctx (Maybe DotCabalPath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DotCabalPath
forall a. Maybe a
Nothing
(Path Abs File
candidate:[Path Abs File]
rest) -> do
DotCabalDescriptor
-> Path Abs File -> [Path Abs File] -> RIO Ctx ()
forall b t.
DotCabalDescriptor -> Path b t -> [Path b t] -> RIO Ctx ()
warnMultiple DotCabalDescriptor
name Path Abs File
candidate [Path Abs File]
rest
Maybe DotCabalPath -> RIO Ctx (Maybe DotCabalPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (DotCabalPath -> Maybe DotCabalPath
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 -> FilePath
paths_pkg PackageName
pkg = FilePath
"Paths_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageName -> FilePath
packageNameString PackageName
pkg
makeNameCandidates :: IO [Path Abs File]
makeNameCandidates =
([[Path Abs File]] -> [Path Abs File])
-> IO [[Path Abs File]] -> IO [Path Abs File]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Path Abs File] -> [Path Abs File]
forall a. Ord a => [a] -> [a]
nubOrd ([Path Abs File] -> [Path Abs File])
-> ([[Path Abs File]] -> [Path Abs File])
-> [[Path Abs File]]
-> [Path Abs File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Path Abs File]] -> [Path Abs File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ((Path Abs Dir -> IO [Path Abs File])
-> [Path Abs Dir] -> IO [[Path Abs File]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Path Abs Dir -> IO [Path Abs File]
makeDirCandidates [Path Abs Dir]
dirs)
makeDirCandidates :: Path Abs Dir
-> IO [Path Abs File]
makeDirCandidates :: Path Abs Dir -> IO [Path Abs File]
makeDirCandidates Path Abs Dir
dir =
case DotCabalDescriptor
name of
DotCabalMain FilePath
fp -> Path Abs Dir -> FilePath -> IO [Path Abs File]
forall (f :: * -> *).
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> FilePath -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir FilePath
fp
DotCabalFile FilePath
fp -> Path Abs Dir -> FilePath -> IO [Path Abs File]
forall (f :: * -> *).
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> FilePath -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir FilePath
fp
DotCabalCFile FilePath
fp -> Path Abs Dir -> FilePath -> IO [Path Abs File]
forall (f :: * -> *).
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> FilePath -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir FilePath
fp
DotCabalModule ModuleName
mn -> do
let perExt :: Text -> f [Path Abs File]
perExt Text
ext =
Path Abs Dir -> FilePath -> f [Path Abs File]
forall (f :: * -> *).
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> FilePath -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir (ModuleName -> FilePath
Cabal.toFilePath ModuleName
mn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack Text
ext)
[[Path Abs File]]
withHaskellExts <- (Text -> IO [Path Abs File]) -> [Text] -> IO [[Path Abs File]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> IO [Path Abs File]
forall (f :: * -> *).
(MonadIO f, MonadThrow f) =>
Text -> f [Path Abs File]
perExt [Text]
haskellFileExts
[[Path Abs File]]
withPPExts <- (Text -> IO [Path Abs File]) -> [Text] -> IO [[Path Abs File]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> IO [Path Abs File]
forall (f :: * -> *).
(MonadIO f, MonadThrow f) =>
Text -> f [Path Abs File]
perExt [Text]
haskellPreprocessorExts
[Path Abs File] -> IO [Path Abs File]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Path Abs File] -> IO [Path Abs File])
-> [Path Abs File] -> IO [Path Abs File]
forall a b. (a -> b) -> a -> b
$
case ([[Path Abs File]] -> [Path Abs File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Path Abs File]]
withHaskellExts, [[Path Abs File]] -> [Path Abs File]
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 [Path Abs File] -> [Path Abs File] -> [Path Abs File]
forall a. [a] -> [a] -> [a]
++ [Path Abs File]
ys
resolveCandidate :: Path Abs Dir -> FilePath -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir = (Maybe (Path Abs File) -> [Path Abs File])
-> f (Maybe (Path Abs File)) -> f [Path Abs File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Path Abs File) -> [Path Abs File]
forall a. Maybe a -> [a]
maybeToList (f (Maybe (Path Abs File)) -> f [Path Abs File])
-> (FilePath -> f (Maybe (Path Abs File)))
-> FilePath
-> f [Path Abs File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> FilePath -> f (Maybe (Path Abs File))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> FilePath -> 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 :: Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
resolveDirFile Path Abs Dir
x FilePath
y = do
Path Abs File
p <- FilePath -> m (Path Abs File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseCollapsedAbsFile (Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
x FilePath -> FilePath -> FilePath
FilePath.</> FilePath
y)
Bool
exists <- Path Abs File -> m Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
p
Maybe (Path Abs File) -> m (Maybe (Path Abs File))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Path Abs File) -> m (Maybe (Path Abs File)))
-> Maybe (Path Abs File) -> m (Maybe (Path Abs File))
forall a b. (a -> b) -> a -> b
$ if Bool
exists then Path Abs File -> Maybe (Path Abs File)
forall a. a -> Maybe a
Just Path Abs File
p else Maybe (Path Abs File)
forall a. Maybe a
Nothing
warnMultiple
:: DotCabalDescriptor -> Path b t -> [Path b t] -> RIO Ctx ()
warnMultiple :: DotCabalDescriptor -> Path b t -> [Path b t] -> RIO Ctx ()
warnMultiple DotCabalDescriptor
name Path b t
candidate [Path b t]
rest =
[StyleDoc] -> RIO Ctx ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ FilePath -> StyleDoc
flow FilePath
"There were multiple candidates for the Cabal entry"
, FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc)
-> (DotCabalDescriptor -> FilePath)
-> DotCabalDescriptor
-> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCabalDescriptor -> FilePath
showName (DotCabalDescriptor -> StyleDoc) -> DotCabalDescriptor -> StyleDoc
forall a b. (a -> b) -> a -> b
$ DotCabalDescriptor
name
, StyleDoc
line StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList ((Path b t -> StyleDoc) -> [Path b t] -> [StyleDoc]
forall a b. (a -> b) -> [a] -> [b]
map Path b t -> StyleDoc
forall b t. Path b t -> StyleDoc
dispOne (Path b t
candidatePath b t -> [Path b t] -> [Path b t]
forall a. a -> [a] -> [a]
:[Path b t]
rest))
, StyleDoc
line StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> FilePath -> StyleDoc
flow FilePath
"picking:"
, Path b t -> StyleDoc
forall b t. Path b t -> StyleDoc
dispOne Path b t
candidate
]
where showName :: DotCabalDescriptor -> FilePath
showName (DotCabalModule ModuleName
name') = ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
D.display ModuleName
name'
showName (DotCabalMain FilePath
fp) = FilePath
fp
showName (DotCabalFile FilePath
fp) = FilePath
fp
showName (DotCabalCFile FilePath
fp) = FilePath
fp
dispOne :: Path b t -> StyleDoc
dispOne = FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc)
-> (Path b t -> FilePath) -> Path b t -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> FilePath
forall b t. Path b t -> FilePath
toFilePath
logPossibilities
:: HasTerm env
=> [Path Abs Dir] -> ModuleName -> RIO env ()
logPossibilities :: [Path Abs Dir] -> ModuleName -> RIO env ()
logPossibilities [Path Abs Dir]
dirs ModuleName
mn = do
[Path Rel File]
possibilities <- ([[Path Rel File]] -> [Path Rel File])
-> RIO env [[Path Rel File]] -> RIO env [Path Rel File]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[Path Rel File]] -> [Path Rel File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ModuleName -> RIO env [[Path Rel File]]
forall (m :: * -> *) a.
(MonadIO m, Pretty a) =>
a -> m [[Path Rel File]]
makePossibilities ModuleName
mn)
Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Path Rel File] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path Rel File]
possibilities) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ FilePath -> StyleDoc
flow FilePath
"Unable to find a known candidate for the Cabal entry"
, (Style -> StyleDoc -> StyleDoc
style Style
PP.Module (StyleDoc -> StyleDoc)
-> (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
D.display ModuleName
mn) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
, FilePath -> StyleDoc
flow FilePath
"but did find:"
, StyleDoc
line StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList ((Path Rel File -> StyleDoc) -> [Path Rel File] -> [StyleDoc]
forall a b. (a -> b) -> [a] -> [b]
map Path Rel File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty [Path Rel File]
possibilities)
, FilePath -> StyleDoc
flow FilePath
"If you are using a custom preprocessor for this module"
, FilePath -> StyleDoc
flow FilePath
"with its own file extension, consider adding the file(s)"
, FilePath -> StyleDoc
flow FilePath
"to your .cabal under extra-source-files."
]
where
makePossibilities :: a -> m [[Path Rel File]]
makePossibilities a
name =
(Path Abs Dir -> m [Path Rel File])
-> [Path Abs Dir] -> m [[Path Rel File]]
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) <- Path Abs Dir -> m ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir Path Abs Dir
dir
[Path Rel File] -> m [Path Rel File]
forall (m :: * -> *) a. Monad m => a -> m a
return
((Path Abs File -> Path Rel File)
-> [Path Abs File] -> [Path Rel File]
forall a b. (a -> b) -> [a] -> [b]
map
Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename
((Path Abs File -> Bool) -> [Path Abs File] -> [Path Abs File]
forall a. (a -> Bool) -> [a] -> [a]
filter
(FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (a -> FilePath
forall a. Pretty a => a -> FilePath
D.display a
name) (FilePath -> Bool)
-> (Path Abs File -> FilePath) -> Path Abs File -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Rel File -> FilePath)
-> (Path Abs File -> Path Rel File) -> Path Abs File -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> Path Rel File
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 :: Package -> Maybe FilePath -> m (Path Abs File)
buildLogPath Package
package' Maybe FilePath
msuffix = do
env
env <- m env
forall r (m :: * -> *). MonadReader r m => m r
ask
let stack :: Path Abs Dir
stack = env -> Path Abs Dir
forall env (m :: * -> *).
(HasBuildConfig env, MonadReader env m) =>
m (Path Abs Dir)
getProjectWorkDir env
env
Path Rel File
fp <- FilePath -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile (FilePath -> m (Path Rel File)) -> FilePath -> m (Path Rel File)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
PackageIdentifier -> FilePath
packageIdentifierString (Package -> PackageIdentifier
packageIdentifier Package
package') FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:
([FilePath] -> [FilePath])
-> (FilePath -> [FilePath] -> [FilePath])
-> Maybe FilePath
-> [FilePath]
-> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [FilePath] -> [FilePath]
forall a. a -> a
id (\FilePath
suffix -> (FilePath
"-" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
suffix FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:)) Maybe FilePath
msuffix [FilePath
".log"]
Path Abs File -> m (Path Abs File)
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs File -> m (Path Abs File))
-> Path Abs File -> m (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
stack Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirLogs Path Rel Dir -> Path Rel File -> Path Rel File
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 :: Text
-> (Path Abs Dir -> FilePath -> RIO Ctx (Maybe a))
-> FilePath
-> RIO Ctx (Maybe a)
resolveOrWarn Text
subject Path Abs Dir -> FilePath -> RIO Ctx (Maybe a)
resolver FilePath
path =
do Path Abs Dir
cwd <- IO (Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
Path Abs File
file <- (Ctx -> Path Abs File) -> RIO Ctx (Path Abs File)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Path Abs File
ctxFile
Path Abs Dir
dir <- (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir)
-> (Ctx -> Path Abs File) -> Ctx -> Path Abs Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
Maybe a
result <- Path Abs Dir -> FilePath -> RIO Ctx (Maybe a)
resolver Path Abs Dir
dir FilePath
path
Bool -> RIO Ctx () -> RIO Ctx ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
result) (RIO Ctx () -> RIO Ctx ()) -> RIO Ctx () -> RIO Ctx ()
forall a b. (a -> b) -> a -> b
$ Text -> Path Abs Dir -> FilePath -> Path Abs File -> RIO Ctx ()
warnMissingFile Text
subject Path Abs Dir
cwd FilePath
path Path Abs File
file
Maybe a -> RIO Ctx (Maybe a)
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 -> FilePath -> Path Abs File -> RIO Ctx ()
warnMissingFile Text
subject Path Abs Dir
cwd FilePath
path Path Abs File
fromFile =
[StyleDoc] -> RIO Ctx ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> (Text -> FilePath) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text
subject
, FilePath -> StyleDoc
flow FilePath
"listed in"
, StyleDoc
-> (Path Rel File -> StyleDoc) -> Maybe (Path Rel File) -> StyleDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
fromFile) Path Rel File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty (Path Abs Dir -> Path Abs File -> Maybe (Path Rel File)
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)
, FilePath -> StyleDoc
flow FilePath
"file does not exist:"
, Style -> StyleDoc -> StyleDoc
style Style
Dir (StyleDoc -> StyleDoc)
-> (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath
path
]
resolveFileOrWarn :: FilePath.FilePath
-> RIO Ctx (Maybe (Path Abs File))
resolveFileOrWarn :: FilePath -> RIO Ctx (Maybe (Path Abs File))
resolveFileOrWarn = Text
-> (Path Abs Dir -> FilePath -> RIO Ctx (Maybe (Path Abs File)))
-> FilePath
-> RIO Ctx (Maybe (Path Abs File))
forall a.
Text
-> (Path Abs Dir -> FilePath -> RIO Ctx (Maybe a))
-> FilePath
-> RIO Ctx (Maybe a)
resolveOrWarn Text
"File" Path Abs Dir -> FilePath -> RIO Ctx (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
f
where f :: Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
f Path Abs Dir
p FilePath
x = IO (Maybe (Path Abs File)) -> m (Maybe (Path Abs File))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Abs File) -> IO (Maybe (Path Abs File))
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (Path Abs Dir -> FilePath -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Path Abs File)
resolveFile Path Abs Dir
p FilePath
x)) m (Maybe (Path Abs File))
-> (Maybe (Path Abs File) -> m (Maybe (Path Abs File)))
-> m (Maybe (Path Abs File))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Path Abs File) -> m (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs File) -> m (Maybe (Path Abs File))
rejectMissingFile
resolveDirOrWarn :: FilePath.FilePath
-> RIO Ctx (Maybe (Path Abs Dir))
resolveDirOrWarn :: FilePath -> RIO Ctx (Maybe (Path Abs Dir))
resolveDirOrWarn = Text
-> (Path Abs Dir -> FilePath -> RIO Ctx (Maybe (Path Abs Dir)))
-> FilePath
-> RIO Ctx (Maybe (Path Abs Dir))
forall a.
Text
-> (Path Abs Dir -> FilePath -> RIO Ctx (Maybe a))
-> FilePath
-> RIO Ctx (Maybe a)
resolveOrWarn Text
"Directory" Path Abs Dir -> FilePath -> RIO Ctx (Maybe (Path Abs Dir))
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Maybe (Path Abs Dir))
f
where f :: Path Abs Dir -> FilePath -> m (Maybe (Path Abs Dir))
f Path Abs Dir
p FilePath
x = IO (Maybe (Path Abs Dir)) -> m (Maybe (Path Abs Dir))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Abs Dir) -> IO (Maybe (Path Abs Dir))
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (Path Abs Dir -> FilePath -> IO (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Path Abs Dir)
resolveDir Path Abs Dir
p FilePath
x)) m (Maybe (Path Abs Dir))
-> (Maybe (Path Abs Dir) -> m (Maybe (Path Abs Dir)))
-> m (Maybe (Path Abs Dir))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Path Abs Dir) -> m (Maybe (Path Abs Dir))
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 = (DepValue -> DepValue -> DepValue)
-> PackageName
-> DepValue
-> Map PackageName DepValue
-> Map PackageName DepValue
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith DepValue -> DepValue -> DepValue
forall a. Semigroup a => a -> a -> a
(<>) PackageName
"Cabal" (VersionRange -> DepType -> DepValue
DepValue VersionRange
cabalVersionRange DepType
AsLibrary)
(Map PackageName DepValue -> Map PackageName DepValue)
-> Map PackageName DepValue -> Map PackageName DepValue
forall a b. (a -> b) -> a -> b
$ Package -> Map PackageName DepValue
packageDeps Package
package
, packageSetupDeps :: Maybe (Map PackageName VersionRange)
packageSetupDeps = Map PackageName VersionRange
-> Maybe (Map PackageName VersionRange)
forall a. a -> Maybe a
Just (Map PackageName VersionRange
-> Maybe (Map PackageName VersionRange))
-> Map PackageName VersionRange
-> Maybe (Map PackageName VersionRange)
forall a b. (a -> b) -> a -> b
$ [(PackageName, VersionRange)] -> Map PackageName VersionRange
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 = Package -> VersionRange
packageCabalSpec Package
package
forceCustomBuild :: Bool
forceCustomBuild =
Package -> BuildType
packageBuildType Package
package BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Simple Bool -> Bool -> Bool
&&
Bool -> Bool
not (Version
cabalVersion Version -> VersionRange -> Bool
`withinRange` VersionRange
cabalVersionRange)