{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module Distribution.Client.ProjectConfig (
ProjectConfig(..),
ProjectConfigBuildOnly(..),
ProjectConfigShared(..),
ProjectConfigProvenance(..),
PackageConfig(..),
MapLast(..),
MapMappend(..),
findProjectRoot,
ProjectRoot(..),
BadProjectRoot(..),
readProjectConfig,
readGlobalConfig,
readProjectLocalExtraConfig,
readProjectLocalFreezeConfig,
reportParseResult,
showProjectConfig,
withProjectOrGlobalConfig,
writeProjectLocalExtraConfig,
writeProjectLocalFreezeConfig,
writeProjectConfigFile,
commandLineFlagsToProjectConfig,
ProjectPackageLocation(..),
BadPackageLocations(..),
BadPackageLocation(..),
BadPackageLocationMatch(..),
findProjectPackages,
fetchAndReadSourcePackages,
lookupLocalPackageConfig,
projectConfigWithBuilderRepoContext,
projectConfigWithSolverRepoContext,
SolverSettings(..),
resolveSolverSettings,
BuildTimeSettings(..),
resolveBuildTimeSettings,
checkBadPerPackageCompilerPaths,
BadPerPackageCompilerPaths(..)
) where
import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Client.ProjectConfig.Types
import Distribution.Client.ProjectConfig.Legacy
import Distribution.Client.RebuildMonad
import Distribution.Client.Glob
( isTrivialFilePathGlob )
import Distribution.Client.VCS
( validateSourceRepos, SourceRepoProblem(..)
, VCS(..), knownVCSs, configureVCS, syncSourceRepos )
import Distribution.Client.Types
import Distribution.Client.DistDirLayout
( DistDirLayout(..), CabalDirLayout(..), ProjectRoot(..) )
import Distribution.Client.GlobalFlags
( RepoContext(..), withRepoContext' )
import Distribution.Client.BuildReports.Types
( ReportLevel(..) )
import Distribution.Client.Config
( loadConfig, getConfigFilePath )
import Distribution.Client.HttpUtils
( HttpTransport, configureTransport, transportCheckHttps
, downloadURI )
import Distribution.Client.Utils.Parsec (renderParseError)
import Distribution.Solver.Types.SourcePackage
import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.PackageConstraint
( PackageProperty(..) )
import Distribution.Package
( PackageName, PackageId, UnitId, packageId )
import Distribution.Types.PackageVersionConstraint
( PackageVersionConstraint(..) )
import Distribution.System
( Platform )
import Distribution.Types.GenericPackageDescription
( GenericPackageDescription )
import Distribution.PackageDescription.Parsec
( parseGenericPackageDescription )
import Distribution.Fields
( runParseResult, PError, PWarning, showPWarning)
import Distribution.Types.SourceRepo
( RepoType(..) )
import Distribution.Client.Types.SourceRepo
( SourceRepoList, SourceRepositoryPackage (..), srpFanOut )
import Distribution.Simple.Compiler
( Compiler, compilerInfo )
import Distribution.Simple.Program
( ConfiguredProgram(..) )
import Distribution.Simple.Setup
( Flag(Flag), toFlag, flagToMaybe, flagToList
, fromFlag, fromFlagOrDefault )
import Distribution.Client.Setup
( defaultSolver, defaultMaxBackjumps )
import Distribution.Simple.InstallDirs
( PathTemplate, fromPathTemplate
, toPathTemplate, substPathTemplate, initialPathTemplateEnv )
import Distribution.Simple.Utils
( die', warn, notice, info, createDirectoryIfMissingVerbose, maybeExit, rawSystemIOWithEnv )
import Distribution.Client.Utils
( determineNumJobs )
import Distribution.Utils.NubList
( fromNubList )
import Distribution.Verbosity
( modifyVerbosity, verbose )
import Distribution.Version
( Version )
import qualified Distribution.Deprecated.ParseUtils as OldParser
( ParseResult(..), locatedErrorMsg, showPWarning )
import Distribution.Client.SrcDist
( packageDirToSdist )
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Archive.Tar.Entry as Tar
import qualified Distribution.Client.Tar as Tar
import qualified Distribution.Client.GZipUtils as GZipUtils
import Control.Monad.Trans (liftIO)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map as Map
import qualified Data.List.NonEmpty as NE
import qualified Data.Set as Set
import qualified Data.Hashable as Hashable
import Numeric (showHex)
import System.FilePath hiding (combine)
import System.IO
( withBinaryFile, IOMode(ReadMode) )
import System.Directory
import Network.URI
( URI(..), URIAuth(..), parseAbsoluteURI, uriToString )
lookupLocalPackageConfig
:: (Semigroup a, Monoid a)
=> (PackageConfig -> a) -> ProjectConfig -> PackageName
-> a
lookupLocalPackageConfig :: forall a.
(Semigroup a, Monoid a) =>
(PackageConfig -> a) -> ProjectConfig -> PackageName -> a
lookupLocalPackageConfig PackageConfig -> a
field ProjectConfig {
PackageConfig
projectConfigLocalPackages :: ProjectConfig -> PackageConfig
projectConfigLocalPackages :: PackageConfig
projectConfigLocalPackages,
MapMappend PackageName PackageConfig
projectConfigSpecificPackage :: ProjectConfig -> MapMappend PackageName PackageConfig
projectConfigSpecificPackage :: MapMappend PackageName PackageConfig
projectConfigSpecificPackage
} PackageName
pkgname =
PackageConfig -> a
field PackageConfig
projectConfigLocalPackages
forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty PackageConfig -> a
field
(forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pkgname (forall k v. MapMappend k v -> Map k v
getMapMappend MapMappend PackageName PackageConfig
projectConfigSpecificPackage))
projectConfigWithBuilderRepoContext :: Verbosity
-> BuildTimeSettings
-> (RepoContext -> IO a) -> IO a
projectConfigWithBuilderRepoContext :: forall a.
Verbosity -> BuildTimeSettings -> (RepoContext -> IO a) -> IO a
projectConfigWithBuilderRepoContext Verbosity
verbosity BuildTimeSettings{Bool
Int
String
[String]
[PathTemplate]
[LocalRepo]
[RemoteRepo]
Maybe String
Maybe (Compiler -> Platform -> PackageId -> UnitId -> String)
Verbosity
ReportLevel
buildSettingHaddockOpen :: BuildTimeSettings -> Bool
buildSettingProgPathExtra :: BuildTimeSettings -> [String]
buildSettingIgnoreExpiry :: BuildTimeSettings -> Bool
buildSettingHttpTransport :: BuildTimeSettings -> Maybe String
buildSettingCacheDir :: BuildTimeSettings -> String
buildSettingLocalNoIndexRepos :: BuildTimeSettings -> [LocalRepo]
buildSettingRemoteRepos :: BuildTimeSettings -> [RemoteRepo]
buildSettingKeepTempFiles :: BuildTimeSettings -> Bool
buildSettingOfflineMode :: BuildTimeSettings -> Bool
buildSettingKeepGoing :: BuildTimeSettings -> Bool
buildSettingNumJobs :: BuildTimeSettings -> Int
buildSettingSymlinkBinDir :: BuildTimeSettings -> [String]
buildSettingReportPlanningFailure :: BuildTimeSettings -> Bool
buildSettingBuildReports :: BuildTimeSettings -> ReportLevel
buildSettingLogVerbosity :: BuildTimeSettings -> Verbosity
buildSettingLogFile :: BuildTimeSettings
-> Maybe (Compiler -> Platform -> PackageId -> UnitId -> String)
buildSettingSummaryFile :: BuildTimeSettings -> [PathTemplate]
buildSettingOnlyDownload :: BuildTimeSettings -> Bool
buildSettingOnlyDeps :: BuildTimeSettings -> Bool
buildSettingDryRun :: BuildTimeSettings -> Bool
buildSettingHaddockOpen :: Bool
buildSettingProgPathExtra :: [String]
buildSettingIgnoreExpiry :: Bool
buildSettingHttpTransport :: Maybe String
buildSettingCacheDir :: String
buildSettingLocalNoIndexRepos :: [LocalRepo]
buildSettingRemoteRepos :: [RemoteRepo]
buildSettingKeepTempFiles :: Bool
buildSettingOfflineMode :: Bool
buildSettingKeepGoing :: Bool
buildSettingNumJobs :: Int
buildSettingSymlinkBinDir :: [String]
buildSettingReportPlanningFailure :: Bool
buildSettingBuildReports :: ReportLevel
buildSettingLogVerbosity :: Verbosity
buildSettingLogFile :: Maybe (Compiler -> Platform -> PackageId -> UnitId -> String)
buildSettingSummaryFile :: [PathTemplate]
buildSettingOnlyDownload :: Bool
buildSettingOnlyDeps :: Bool
buildSettingDryRun :: Bool
..} =
forall a.
Verbosity
-> [RemoteRepo]
-> [LocalRepo]
-> String
-> Maybe String
-> Maybe Bool
-> [String]
-> (RepoContext -> IO a)
-> IO a
withRepoContext'
Verbosity
verbosity
[RemoteRepo]
buildSettingRemoteRepos
[LocalRepo]
buildSettingLocalNoIndexRepos
String
buildSettingCacheDir
Maybe String
buildSettingHttpTransport
(forall a. a -> Maybe a
Just Bool
buildSettingIgnoreExpiry)
[String]
buildSettingProgPathExtra
projectConfigWithSolverRepoContext
:: Verbosity -> ProjectConfigShared -> ProjectConfigBuildOnly
-> (RepoContext -> IO a)
-> IO a
projectConfigWithSolverRepoContext :: forall a.
Verbosity
-> ProjectConfigShared
-> ProjectConfigBuildOnly
-> (RepoContext -> IO a)
-> IO a
projectConfigWithSolverRepoContext Verbosity
verbosity
ProjectConfigShared{[Maybe PackageDB]
[(UserConstraint, ConstraintSource)]
[PackageVersionConstraint]
Maybe AllowOlder
Maybe AllowNewer
NubList String
NubList LocalRepo
NubList RemoteRepo
InstallDirs (Flag PathTemplate)
Flag Bool
Flag Int
Flag String
Flag CompilerFlavor
Flag PathTemplate
Flag Version
Flag ReorderGoals
Flag CountConflicts
Flag FineGrainedConflicts
Flag MinimizeConflictSet
Flag IndependentGoals
Flag PreferOldest
Flag StrongFlags
Flag AllowBootLibInstalls
Flag OnlyConstrained
Flag PreSolver
Flag TotalIndexState
Flag ActiveRepos
Flag WriteGhcEnvironmentFilesPolicy
projectConfigProgPathExtra :: ProjectConfigShared -> NubList String
projectConfigPreferOldest :: ProjectConfigShared -> Flag PreferOldest
projectConfigIndependentGoals :: ProjectConfigShared -> Flag IndependentGoals
projectConfigPerComponent :: ProjectConfigShared -> Flag Bool
projectConfigOnlyConstrained :: ProjectConfigShared -> Flag OnlyConstrained
projectConfigAllowBootLibInstalls :: ProjectConfigShared -> Flag AllowBootLibInstalls
projectConfigStrongFlags :: ProjectConfigShared -> Flag StrongFlags
projectConfigMinimizeConflictSet :: ProjectConfigShared -> Flag MinimizeConflictSet
projectConfigFineGrainedConflicts :: ProjectConfigShared -> Flag FineGrainedConflicts
projectConfigCountConflicts :: ProjectConfigShared -> Flag CountConflicts
projectConfigReorderGoals :: ProjectConfigShared -> Flag ReorderGoals
projectConfigMaxBackjumps :: ProjectConfigShared -> Flag Int
projectConfigWriteGhcEnvironmentFilesPolicy :: ProjectConfigShared -> Flag WriteGhcEnvironmentFilesPolicy
projectConfigAllowNewer :: ProjectConfigShared -> Maybe AllowNewer
projectConfigAllowOlder :: ProjectConfigShared -> Maybe AllowOlder
projectConfigSolver :: ProjectConfigShared -> Flag PreSolver
projectConfigCabalVersion :: ProjectConfigShared -> Flag Version
projectConfigPreferences :: ProjectConfigShared -> [PackageVersionConstraint]
projectConfigConstraints :: ProjectConfigShared -> [(UserConstraint, ConstraintSource)]
projectConfigStoreDir :: ProjectConfigShared -> Flag String
projectConfigIndexState :: ProjectConfigShared -> Flag TotalIndexState
projectConfigActiveRepos :: ProjectConfigShared -> Flag ActiveRepos
projectConfigLocalNoIndexRepos :: ProjectConfigShared -> NubList LocalRepo
projectConfigRemoteRepos :: ProjectConfigShared -> NubList RemoteRepo
projectConfigPackageDBs :: ProjectConfigShared -> [Maybe PackageDB]
projectConfigInstallDirs :: ProjectConfigShared -> InstallDirs (Flag PathTemplate)
projectConfigHaddockIndex :: ProjectConfigShared -> Flag PathTemplate
projectConfigHcPkg :: ProjectConfigShared -> Flag String
projectConfigHcPath :: ProjectConfigShared -> Flag String
projectConfigHcFlavor :: ProjectConfigShared -> Flag CompilerFlavor
projectConfigIgnoreProject :: ProjectConfigShared -> Flag Bool
projectConfigProjectFile :: ProjectConfigShared -> Flag String
projectConfigConfigFile :: ProjectConfigShared -> Flag String
projectConfigDistDir :: ProjectConfigShared -> Flag String
projectConfigProgPathExtra :: NubList String
projectConfigPreferOldest :: Flag PreferOldest
projectConfigIndependentGoals :: Flag IndependentGoals
projectConfigPerComponent :: Flag Bool
projectConfigOnlyConstrained :: Flag OnlyConstrained
projectConfigAllowBootLibInstalls :: Flag AllowBootLibInstalls
projectConfigStrongFlags :: Flag StrongFlags
projectConfigMinimizeConflictSet :: Flag MinimizeConflictSet
projectConfigFineGrainedConflicts :: Flag FineGrainedConflicts
projectConfigCountConflicts :: Flag CountConflicts
projectConfigReorderGoals :: Flag ReorderGoals
projectConfigMaxBackjumps :: Flag Int
projectConfigWriteGhcEnvironmentFilesPolicy :: Flag WriteGhcEnvironmentFilesPolicy
projectConfigAllowNewer :: Maybe AllowNewer
projectConfigAllowOlder :: Maybe AllowOlder
projectConfigSolver :: Flag PreSolver
projectConfigCabalVersion :: Flag Version
projectConfigPreferences :: [PackageVersionConstraint]
projectConfigConstraints :: [(UserConstraint, ConstraintSource)]
projectConfigStoreDir :: Flag String
projectConfigIndexState :: Flag TotalIndexState
projectConfigActiveRepos :: Flag ActiveRepos
projectConfigLocalNoIndexRepos :: NubList LocalRepo
projectConfigRemoteRepos :: NubList RemoteRepo
projectConfigPackageDBs :: [Maybe PackageDB]
projectConfigInstallDirs :: InstallDirs (Flag PathTemplate)
projectConfigHaddockIndex :: Flag PathTemplate
projectConfigHcPkg :: Flag String
projectConfigHcPath :: Flag String
projectConfigHcFlavor :: Flag CompilerFlavor
projectConfigIgnoreProject :: Flag Bool
projectConfigProjectFile :: Flag String
projectConfigConfigFile :: Flag String
projectConfigDistDir :: Flag String
..}
ProjectConfigBuildOnly{NubList PathTemplate
Flag Bool
Flag String
Flag (Maybe Int)
Flag Verbosity
Flag PathTemplate
Flag ReportLevel
ClientInstallFlags
projectConfigClientInstallFlags :: ProjectConfigBuildOnly -> ClientInstallFlags
projectConfigLogsDir :: ProjectConfigBuildOnly -> Flag String
projectConfigCacheDir :: ProjectConfigBuildOnly -> Flag String
projectConfigIgnoreExpiry :: ProjectConfigBuildOnly -> Flag Bool
projectConfigHttpTransport :: ProjectConfigBuildOnly -> Flag String
projectConfigKeepTempFiles :: ProjectConfigBuildOnly -> Flag Bool
projectConfigOfflineMode :: ProjectConfigBuildOnly -> Flag Bool
projectConfigKeepGoing :: ProjectConfigBuildOnly -> Flag Bool
projectConfigNumJobs :: ProjectConfigBuildOnly -> Flag (Maybe Int)
projectConfigSymlinkBinDir :: ProjectConfigBuildOnly -> Flag String
projectConfigReportPlanningFailure :: ProjectConfigBuildOnly -> Flag Bool
projectConfigBuildReports :: ProjectConfigBuildOnly -> Flag ReportLevel
projectConfigLogFile :: ProjectConfigBuildOnly -> Flag PathTemplate
projectConfigSummaryFile :: ProjectConfigBuildOnly -> NubList PathTemplate
projectConfigOnlyDownload :: ProjectConfigBuildOnly -> Flag Bool
projectConfigOnlyDeps :: ProjectConfigBuildOnly -> Flag Bool
projectConfigDryRun :: ProjectConfigBuildOnly -> Flag Bool
projectConfigVerbosity :: ProjectConfigBuildOnly -> Flag Verbosity
projectConfigClientInstallFlags :: ClientInstallFlags
projectConfigLogsDir :: Flag String
projectConfigCacheDir :: Flag String
projectConfigIgnoreExpiry :: Flag Bool
projectConfigHttpTransport :: Flag String
projectConfigKeepTempFiles :: Flag Bool
projectConfigOfflineMode :: Flag Bool
projectConfigKeepGoing :: Flag Bool
projectConfigNumJobs :: Flag (Maybe Int)
projectConfigSymlinkBinDir :: Flag String
projectConfigReportPlanningFailure :: Flag Bool
projectConfigBuildReports :: Flag ReportLevel
projectConfigLogFile :: Flag PathTemplate
projectConfigSummaryFile :: NubList PathTemplate
projectConfigOnlyDownload :: Flag Bool
projectConfigOnlyDeps :: Flag Bool
projectConfigDryRun :: Flag Bool
projectConfigVerbosity :: Flag Verbosity
..} =
forall a.
Verbosity
-> [RemoteRepo]
-> [LocalRepo]
-> String
-> Maybe String
-> Maybe Bool
-> [String]
-> (RepoContext -> IO a)
-> IO a
withRepoContext'
Verbosity
verbosity
(forall a. NubList a -> [a]
fromNubList NubList RemoteRepo
projectConfigRemoteRepos)
(forall a. NubList a -> [a]
fromNubList NubList LocalRepo
projectConfigLocalNoIndexRepos)
(forall a. a -> Flag a -> a
fromFlagOrDefault
(forall a. HasCallStack => String -> a
error
String
"projectConfigWithSolverRepoContext: projectConfigCacheDir")
Flag String
projectConfigCacheDir)
(forall a. Flag a -> Maybe a
flagToMaybe Flag String
projectConfigHttpTransport)
(forall a. Flag a -> Maybe a
flagToMaybe Flag Bool
projectConfigIgnoreExpiry)
(forall a. NubList a -> [a]
fromNubList NubList String
projectConfigProgPathExtra)
resolveSolverSettings :: ProjectConfig -> SolverSettings
resolveSolverSettings :: ProjectConfig -> SolverSettings
resolveSolverSettings ProjectConfig{
ProjectConfigShared
projectConfigShared :: ProjectConfig -> ProjectConfigShared
projectConfigShared :: ProjectConfigShared
projectConfigShared,
PackageConfig
projectConfigLocalPackages :: PackageConfig
projectConfigLocalPackages :: ProjectConfig -> PackageConfig
projectConfigLocalPackages,
MapMappend PackageName PackageConfig
projectConfigSpecificPackage :: MapMappend PackageName PackageConfig
projectConfigSpecificPackage :: ProjectConfig -> MapMappend PackageName PackageConfig
projectConfigSpecificPackage
} =
SolverSettings {[(UserConstraint, ConstraintSource)]
[PackageVersionConstraint]
[LocalRepo]
[RemoteRepo]
Maybe Int
Maybe Version
Maybe TotalIndexState
Maybe ActiveRepos
Map PackageName FlagAssignment
FlagAssignment
ReorderGoals
CountConflicts
FineGrainedConflicts
MinimizeConflictSet
IndependentGoals
PreferOldest
StrongFlags
AllowBootLibInstalls
OnlyConstrained
PreSolver
AllowOlder
AllowNewer
solverSettingPreferOldest :: PreferOldest
solverSettingIndependentGoals :: IndependentGoals
solverSettingActiveRepos :: Maybe ActiveRepos
solverSettingIndexState :: Maybe TotalIndexState
solverSettingOnlyConstrained :: OnlyConstrained
solverSettingAllowBootLibInstalls :: AllowBootLibInstalls
solverSettingStrongFlags :: StrongFlags
solverSettingMinimizeConflictSet :: MinimizeConflictSet
solverSettingFineGrainedConflicts :: FineGrainedConflicts
solverSettingCountConflicts :: CountConflicts
solverSettingReorderGoals :: ReorderGoals
solverSettingMaxBackjumps :: Maybe Int
solverSettingAllowNewer :: AllowNewer
solverSettingAllowOlder :: AllowOlder
solverSettingSolver :: PreSolver
solverSettingCabalVersion :: Maybe Version
solverSettingFlagAssignments :: Map PackageName FlagAssignment
solverSettingFlagAssignment :: FlagAssignment
solverSettingPreferences :: [PackageVersionConstraint]
solverSettingConstraints :: [(UserConstraint, ConstraintSource)]
solverSettingLocalNoIndexRepos :: [LocalRepo]
solverSettingRemoteRepos :: [RemoteRepo]
solverSettingPreferOldest :: PreferOldest
solverSettingIndependentGoals :: IndependentGoals
solverSettingActiveRepos :: Maybe ActiveRepos
solverSettingIndexState :: Maybe TotalIndexState
solverSettingOnlyConstrained :: OnlyConstrained
solverSettingAllowBootLibInstalls :: AllowBootLibInstalls
solverSettingStrongFlags :: StrongFlags
solverSettingMinimizeConflictSet :: MinimizeConflictSet
solverSettingFineGrainedConflicts :: FineGrainedConflicts
solverSettingCountConflicts :: CountConflicts
solverSettingReorderGoals :: ReorderGoals
solverSettingMaxBackjumps :: Maybe Int
solverSettingAllowNewer :: AllowNewer
solverSettingAllowOlder :: AllowOlder
solverSettingSolver :: PreSolver
solverSettingCabalVersion :: Maybe Version
solverSettingFlagAssignments :: Map PackageName FlagAssignment
solverSettingFlagAssignment :: FlagAssignment
solverSettingPreferences :: [PackageVersionConstraint]
solverSettingConstraints :: [(UserConstraint, ConstraintSource)]
solverSettingLocalNoIndexRepos :: [LocalRepo]
solverSettingRemoteRepos :: [RemoteRepo]
..}
where
solverSettingRemoteRepos :: [RemoteRepo]
solverSettingRemoteRepos = forall a. NubList a -> [a]
fromNubList NubList RemoteRepo
projectConfigRemoteRepos
solverSettingLocalNoIndexRepos :: [LocalRepo]
solverSettingLocalNoIndexRepos = forall a. NubList a -> [a]
fromNubList NubList LocalRepo
projectConfigLocalNoIndexRepos
solverSettingConstraints :: [(UserConstraint, ConstraintSource)]
solverSettingConstraints = [(UserConstraint, ConstraintSource)]
projectConfigConstraints
solverSettingPreferences :: [PackageVersionConstraint]
solverSettingPreferences = [PackageVersionConstraint]
projectConfigPreferences
solverSettingFlagAssignment :: FlagAssignment
solverSettingFlagAssignment = PackageConfig -> FlagAssignment
packageConfigFlagAssignment PackageConfig
projectConfigLocalPackages
solverSettingFlagAssignments :: Map PackageName FlagAssignment
solverSettingFlagAssignments = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageConfig -> FlagAssignment
packageConfigFlagAssignment
(forall k v. MapMappend k v -> Map k v
getMapMappend MapMappend PackageName PackageConfig
projectConfigSpecificPackage)
solverSettingCabalVersion :: Maybe Version
solverSettingCabalVersion = forall a. Flag a -> Maybe a
flagToMaybe Flag Version
projectConfigCabalVersion
solverSettingSolver :: PreSolver
solverSettingSolver = forall a. WithCallStack (Flag a -> a)
fromFlag Flag PreSolver
projectConfigSolver
solverSettingAllowOlder :: AllowOlder
solverSettingAllowOlder = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe AllowOlder
projectConfigAllowOlder
solverSettingAllowNewer :: AllowNewer
solverSettingAllowNewer = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe AllowNewer
projectConfigAllowNewer
solverSettingMaxBackjumps :: Maybe Int
solverSettingMaxBackjumps = case forall a. WithCallStack (Flag a -> a)
fromFlag Flag Int
projectConfigMaxBackjumps of
Int
n | Int
n forall a. Ord a => a -> a -> Bool
< Int
0 -> forall a. Maybe a
Nothing
| Bool
otherwise -> forall a. a -> Maybe a
Just Int
n
solverSettingReorderGoals :: ReorderGoals
solverSettingReorderGoals = forall a. WithCallStack (Flag a -> a)
fromFlag Flag ReorderGoals
projectConfigReorderGoals
solverSettingCountConflicts :: CountConflicts
solverSettingCountConflicts = forall a. WithCallStack (Flag a -> a)
fromFlag Flag CountConflicts
projectConfigCountConflicts
solverSettingFineGrainedConflicts :: FineGrainedConflicts
solverSettingFineGrainedConflicts = forall a. WithCallStack (Flag a -> a)
fromFlag Flag FineGrainedConflicts
projectConfigFineGrainedConflicts
solverSettingMinimizeConflictSet :: MinimizeConflictSet
solverSettingMinimizeConflictSet = forall a. WithCallStack (Flag a -> a)
fromFlag Flag MinimizeConflictSet
projectConfigMinimizeConflictSet
solverSettingStrongFlags :: StrongFlags
solverSettingStrongFlags = forall a. WithCallStack (Flag a -> a)
fromFlag Flag StrongFlags
projectConfigStrongFlags
solverSettingAllowBootLibInstalls :: AllowBootLibInstalls
solverSettingAllowBootLibInstalls = forall a. WithCallStack (Flag a -> a)
fromFlag Flag AllowBootLibInstalls
projectConfigAllowBootLibInstalls
solverSettingOnlyConstrained :: OnlyConstrained
solverSettingOnlyConstrained = forall a. WithCallStack (Flag a -> a)
fromFlag Flag OnlyConstrained
projectConfigOnlyConstrained
solverSettingIndexState :: Maybe TotalIndexState
solverSettingIndexState = forall a. Flag a -> Maybe a
flagToMaybe Flag TotalIndexState
projectConfigIndexState
solverSettingActiveRepos :: Maybe ActiveRepos
solverSettingActiveRepos = forall a. Flag a -> Maybe a
flagToMaybe Flag ActiveRepos
projectConfigActiveRepos
solverSettingIndependentGoals :: IndependentGoals
solverSettingIndependentGoals = forall a. WithCallStack (Flag a -> a)
fromFlag Flag IndependentGoals
projectConfigIndependentGoals
solverSettingPreferOldest :: PreferOldest
solverSettingPreferOldest = forall a. WithCallStack (Flag a -> a)
fromFlag Flag PreferOldest
projectConfigPreferOldest
ProjectConfigShared {[Maybe PackageDB]
[(UserConstraint, ConstraintSource)]
[PackageVersionConstraint]
Maybe AllowOlder
Maybe AllowNewer
NubList String
NubList LocalRepo
NubList RemoteRepo
InstallDirs (Flag PathTemplate)
Flag Bool
Flag Int
Flag String
Flag CompilerFlavor
Flag PathTemplate
Flag Version
Flag ReorderGoals
Flag CountConflicts
Flag FineGrainedConflicts
Flag MinimizeConflictSet
Flag IndependentGoals
Flag PreferOldest
Flag StrongFlags
Flag AllowBootLibInstalls
Flag OnlyConstrained
Flag PreSolver
Flag TotalIndexState
Flag ActiveRepos
Flag WriteGhcEnvironmentFilesPolicy
projectConfigProgPathExtra :: NubList String
projectConfigPerComponent :: Flag Bool
projectConfigWriteGhcEnvironmentFilesPolicy :: Flag WriteGhcEnvironmentFilesPolicy
projectConfigStoreDir :: Flag String
projectConfigPackageDBs :: [Maybe PackageDB]
projectConfigInstallDirs :: InstallDirs (Flag PathTemplate)
projectConfigHaddockIndex :: Flag PathTemplate
projectConfigHcPkg :: Flag String
projectConfigHcPath :: Flag String
projectConfigHcFlavor :: Flag CompilerFlavor
projectConfigIgnoreProject :: Flag Bool
projectConfigProjectFile :: Flag String
projectConfigConfigFile :: Flag String
projectConfigDistDir :: Flag String
projectConfigPreferOldest :: Flag PreferOldest
projectConfigIndependentGoals :: Flag IndependentGoals
projectConfigActiveRepos :: Flag ActiveRepos
projectConfigIndexState :: Flag TotalIndexState
projectConfigOnlyConstrained :: Flag OnlyConstrained
projectConfigAllowBootLibInstalls :: Flag AllowBootLibInstalls
projectConfigStrongFlags :: Flag StrongFlags
projectConfigMinimizeConflictSet :: Flag MinimizeConflictSet
projectConfigFineGrainedConflicts :: Flag FineGrainedConflicts
projectConfigCountConflicts :: Flag CountConflicts
projectConfigReorderGoals :: Flag ReorderGoals
projectConfigMaxBackjumps :: Flag Int
projectConfigAllowNewer :: Maybe AllowNewer
projectConfigAllowOlder :: Maybe AllowOlder
projectConfigSolver :: Flag PreSolver
projectConfigCabalVersion :: Flag Version
projectConfigPreferences :: [PackageVersionConstraint]
projectConfigConstraints :: [(UserConstraint, ConstraintSource)]
projectConfigLocalNoIndexRepos :: NubList LocalRepo
projectConfigRemoteRepos :: NubList RemoteRepo
projectConfigProgPathExtra :: ProjectConfigShared -> NubList String
projectConfigPreferOldest :: ProjectConfigShared -> Flag PreferOldest
projectConfigIndependentGoals :: ProjectConfigShared -> Flag IndependentGoals
projectConfigPerComponent :: ProjectConfigShared -> Flag Bool
projectConfigOnlyConstrained :: ProjectConfigShared -> Flag OnlyConstrained
projectConfigAllowBootLibInstalls :: ProjectConfigShared -> Flag AllowBootLibInstalls
projectConfigStrongFlags :: ProjectConfigShared -> Flag StrongFlags
projectConfigMinimizeConflictSet :: ProjectConfigShared -> Flag MinimizeConflictSet
projectConfigFineGrainedConflicts :: ProjectConfigShared -> Flag FineGrainedConflicts
projectConfigCountConflicts :: ProjectConfigShared -> Flag CountConflicts
projectConfigReorderGoals :: ProjectConfigShared -> Flag ReorderGoals
projectConfigMaxBackjumps :: ProjectConfigShared -> Flag Int
projectConfigWriteGhcEnvironmentFilesPolicy :: ProjectConfigShared -> Flag WriteGhcEnvironmentFilesPolicy
projectConfigAllowNewer :: ProjectConfigShared -> Maybe AllowNewer
projectConfigAllowOlder :: ProjectConfigShared -> Maybe AllowOlder
projectConfigSolver :: ProjectConfigShared -> Flag PreSolver
projectConfigCabalVersion :: ProjectConfigShared -> Flag Version
projectConfigPreferences :: ProjectConfigShared -> [PackageVersionConstraint]
projectConfigConstraints :: ProjectConfigShared -> [(UserConstraint, ConstraintSource)]
projectConfigStoreDir :: ProjectConfigShared -> Flag String
projectConfigIndexState :: ProjectConfigShared -> Flag TotalIndexState
projectConfigActiveRepos :: ProjectConfigShared -> Flag ActiveRepos
projectConfigLocalNoIndexRepos :: ProjectConfigShared -> NubList LocalRepo
projectConfigRemoteRepos :: ProjectConfigShared -> NubList RemoteRepo
projectConfigPackageDBs :: ProjectConfigShared -> [Maybe PackageDB]
projectConfigInstallDirs :: ProjectConfigShared -> InstallDirs (Flag PathTemplate)
projectConfigHaddockIndex :: ProjectConfigShared -> Flag PathTemplate
projectConfigHcPkg :: ProjectConfigShared -> Flag String
projectConfigHcPath :: ProjectConfigShared -> Flag String
projectConfigHcFlavor :: ProjectConfigShared -> Flag CompilerFlavor
projectConfigIgnoreProject :: ProjectConfigShared -> Flag Bool
projectConfigProjectFile :: ProjectConfigShared -> Flag String
projectConfigConfigFile :: ProjectConfigShared -> Flag String
projectConfigDistDir :: ProjectConfigShared -> Flag String
..} = ProjectConfigShared
defaults forall a. Semigroup a => a -> a -> a
<> ProjectConfigShared
projectConfigShared
defaults :: ProjectConfigShared
defaults = forall a. Monoid a => a
mempty {
projectConfigSolver :: Flag PreSolver
projectConfigSolver = forall a. a -> Flag a
Flag PreSolver
defaultSolver,
projectConfigAllowOlder :: Maybe AllowOlder
projectConfigAllowOlder = forall a. a -> Maybe a
Just (RelaxDeps -> AllowOlder
AllowOlder forall a. Monoid a => a
mempty),
projectConfigAllowNewer :: Maybe AllowNewer
projectConfigAllowNewer = forall a. a -> Maybe a
Just (RelaxDeps -> AllowNewer
AllowNewer forall a. Monoid a => a
mempty),
projectConfigMaxBackjumps :: Flag Int
projectConfigMaxBackjumps = forall a. a -> Flag a
Flag Int
defaultMaxBackjumps,
projectConfigReorderGoals :: Flag ReorderGoals
projectConfigReorderGoals = forall a. a -> Flag a
Flag (Bool -> ReorderGoals
ReorderGoals Bool
False),
projectConfigCountConflicts :: Flag CountConflicts
projectConfigCountConflicts = forall a. a -> Flag a
Flag (Bool -> CountConflicts
CountConflicts Bool
True),
projectConfigFineGrainedConflicts :: Flag FineGrainedConflicts
projectConfigFineGrainedConflicts = forall a. a -> Flag a
Flag (Bool -> FineGrainedConflicts
FineGrainedConflicts Bool
True),
projectConfigMinimizeConflictSet :: Flag MinimizeConflictSet
projectConfigMinimizeConflictSet = forall a. a -> Flag a
Flag (Bool -> MinimizeConflictSet
MinimizeConflictSet Bool
False),
projectConfigStrongFlags :: Flag StrongFlags
projectConfigStrongFlags = forall a. a -> Flag a
Flag (Bool -> StrongFlags
StrongFlags Bool
False),
projectConfigAllowBootLibInstalls :: Flag AllowBootLibInstalls
projectConfigAllowBootLibInstalls = forall a. a -> Flag a
Flag (Bool -> AllowBootLibInstalls
AllowBootLibInstalls Bool
False),
projectConfigOnlyConstrained :: Flag OnlyConstrained
projectConfigOnlyConstrained = forall a. a -> Flag a
Flag OnlyConstrained
OnlyConstrainedNone,
projectConfigIndependentGoals :: Flag IndependentGoals
projectConfigIndependentGoals = forall a. a -> Flag a
Flag (Bool -> IndependentGoals
IndependentGoals Bool
False),
projectConfigPreferOldest :: Flag PreferOldest
projectConfigPreferOldest = forall a. a -> Flag a
Flag (Bool -> PreferOldest
PreferOldest Bool
False)
}
resolveBuildTimeSettings :: Verbosity
-> CabalDirLayout
-> ProjectConfig
-> BuildTimeSettings
resolveBuildTimeSettings :: Verbosity -> CabalDirLayout -> ProjectConfig -> BuildTimeSettings
resolveBuildTimeSettings Verbosity
verbosity
CabalDirLayout {
String
cabalLogsDirectory :: CabalDirLayout -> String
cabalLogsDirectory :: String
cabalLogsDirectory
}
ProjectConfig {
projectConfigShared :: ProjectConfig -> ProjectConfigShared
projectConfigShared = ProjectConfigShared {
NubList RemoteRepo
projectConfigRemoteRepos :: NubList RemoteRepo
projectConfigRemoteRepos :: ProjectConfigShared -> NubList RemoteRepo
projectConfigRemoteRepos,
NubList LocalRepo
projectConfigLocalNoIndexRepos :: NubList LocalRepo
projectConfigLocalNoIndexRepos :: ProjectConfigShared -> NubList LocalRepo
projectConfigLocalNoIndexRepos,
NubList String
projectConfigProgPathExtra :: NubList String
projectConfigProgPathExtra :: ProjectConfigShared -> NubList String
projectConfigProgPathExtra
},
ProjectConfigBuildOnly
projectConfigBuildOnly :: ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly :: ProjectConfigBuildOnly
projectConfigBuildOnly
} =
BuildTimeSettings {Bool
Int
String
[String]
[PathTemplate]
[LocalRepo]
[RemoteRepo]
Maybe String
Maybe (Compiler -> Platform -> PackageId -> UnitId -> String)
Verbosity
ReportLevel
buildSettingLogVerbosity :: Verbosity
buildSettingLogFile :: Maybe (Compiler -> Platform -> PackageId -> UnitId -> String)
buildSettingHaddockOpen :: Bool
buildSettingProgPathExtra :: [String]
buildSettingReportPlanningFailure :: Bool
buildSettingIgnoreExpiry :: Bool
buildSettingHttpTransport :: Maybe String
buildSettingCacheDir :: String
buildSettingLocalNoIndexRepos :: [LocalRepo]
buildSettingRemoteRepos :: [RemoteRepo]
buildSettingKeepTempFiles :: Bool
buildSettingOfflineMode :: Bool
buildSettingKeepGoing :: Bool
buildSettingNumJobs :: Int
buildSettingSymlinkBinDir :: [String]
buildSettingBuildReports :: ReportLevel
buildSettingSummaryFile :: [PathTemplate]
buildSettingOnlyDownload :: Bool
buildSettingOnlyDeps :: Bool
buildSettingDryRun :: Bool
buildSettingHaddockOpen :: Bool
buildSettingProgPathExtra :: [String]
buildSettingIgnoreExpiry :: Bool
buildSettingHttpTransport :: Maybe String
buildSettingCacheDir :: String
buildSettingLocalNoIndexRepos :: [LocalRepo]
buildSettingRemoteRepos :: [RemoteRepo]
buildSettingKeepTempFiles :: Bool
buildSettingOfflineMode :: Bool
buildSettingKeepGoing :: Bool
buildSettingNumJobs :: Int
buildSettingSymlinkBinDir :: [String]
buildSettingReportPlanningFailure :: Bool
buildSettingBuildReports :: ReportLevel
buildSettingLogVerbosity :: Verbosity
buildSettingLogFile :: Maybe (Compiler -> Platform -> PackageId -> UnitId -> String)
buildSettingSummaryFile :: [PathTemplate]
buildSettingOnlyDownload :: Bool
buildSettingOnlyDeps :: Bool
buildSettingDryRun :: Bool
..}
where
buildSettingDryRun :: Bool
buildSettingDryRun = forall a. WithCallStack (Flag a -> a)
fromFlag Flag Bool
projectConfigDryRun
buildSettingOnlyDeps :: Bool
buildSettingOnlyDeps = forall a. WithCallStack (Flag a -> a)
fromFlag Flag Bool
projectConfigOnlyDeps
buildSettingOnlyDownload :: Bool
buildSettingOnlyDownload = forall a. WithCallStack (Flag a -> a)
fromFlag Flag Bool
projectConfigOnlyDownload
buildSettingSummaryFile :: [PathTemplate]
buildSettingSummaryFile = forall a. NubList a -> [a]
fromNubList NubList PathTemplate
projectConfigSummaryFile
buildSettingBuildReports :: ReportLevel
buildSettingBuildReports = forall a. WithCallStack (Flag a -> a)
fromFlag Flag ReportLevel
projectConfigBuildReports
buildSettingSymlinkBinDir :: [String]
buildSettingSymlinkBinDir = forall a. Flag a -> [a]
flagToList Flag String
projectConfigSymlinkBinDir
buildSettingNumJobs :: Int
buildSettingNumJobs = Flag (Maybe Int) -> Int
determineNumJobs Flag (Maybe Int)
projectConfigNumJobs
buildSettingKeepGoing :: Bool
buildSettingKeepGoing = forall a. WithCallStack (Flag a -> a)
fromFlag Flag Bool
projectConfigKeepGoing
buildSettingOfflineMode :: Bool
buildSettingOfflineMode = forall a. WithCallStack (Flag a -> a)
fromFlag Flag Bool
projectConfigOfflineMode
buildSettingKeepTempFiles :: Bool
buildSettingKeepTempFiles = forall a. WithCallStack (Flag a -> a)
fromFlag Flag Bool
projectConfigKeepTempFiles
buildSettingRemoteRepos :: [RemoteRepo]
buildSettingRemoteRepos = forall a. NubList a -> [a]
fromNubList NubList RemoteRepo
projectConfigRemoteRepos
buildSettingLocalNoIndexRepos :: [LocalRepo]
buildSettingLocalNoIndexRepos = forall a. NubList a -> [a]
fromNubList NubList LocalRepo
projectConfigLocalNoIndexRepos
buildSettingCacheDir :: String
buildSettingCacheDir = forall a. WithCallStack (Flag a -> a)
fromFlag Flag String
projectConfigCacheDir
buildSettingHttpTransport :: Maybe String
buildSettingHttpTransport = forall a. Flag a -> Maybe a
flagToMaybe Flag String
projectConfigHttpTransport
buildSettingIgnoreExpiry :: Bool
buildSettingIgnoreExpiry = forall a. WithCallStack (Flag a -> a)
fromFlag Flag Bool
projectConfigIgnoreExpiry
buildSettingReportPlanningFailure :: Bool
buildSettingReportPlanningFailure
= forall a. WithCallStack (Flag a -> a)
fromFlag Flag Bool
projectConfigReportPlanningFailure
buildSettingProgPathExtra :: [String]
buildSettingProgPathExtra = forall a. NubList a -> [a]
fromNubList NubList String
projectConfigProgPathExtra
buildSettingHaddockOpen :: Bool
buildSettingHaddockOpen = Bool
False
ProjectConfigBuildOnly{NubList PathTemplate
Flag Bool
Flag String
Flag (Maybe Int)
Flag Verbosity
Flag PathTemplate
Flag ReportLevel
ClientInstallFlags
projectConfigClientInstallFlags :: ClientInstallFlags
projectConfigLogsDir :: Flag String
projectConfigLogFile :: Flag PathTemplate
projectConfigVerbosity :: Flag Verbosity
projectConfigReportPlanningFailure :: Flag Bool
projectConfigIgnoreExpiry :: Flag Bool
projectConfigHttpTransport :: Flag String
projectConfigCacheDir :: Flag String
projectConfigKeepTempFiles :: Flag Bool
projectConfigOfflineMode :: Flag Bool
projectConfigKeepGoing :: Flag Bool
projectConfigNumJobs :: Flag (Maybe Int)
projectConfigSymlinkBinDir :: Flag String
projectConfigBuildReports :: Flag ReportLevel
projectConfigSummaryFile :: NubList PathTemplate
projectConfigOnlyDownload :: Flag Bool
projectConfigOnlyDeps :: Flag Bool
projectConfigDryRun :: Flag Bool
projectConfigClientInstallFlags :: ProjectConfigBuildOnly -> ClientInstallFlags
projectConfigLogsDir :: ProjectConfigBuildOnly -> Flag String
projectConfigCacheDir :: ProjectConfigBuildOnly -> Flag String
projectConfigIgnoreExpiry :: ProjectConfigBuildOnly -> Flag Bool
projectConfigHttpTransport :: ProjectConfigBuildOnly -> Flag String
projectConfigKeepTempFiles :: ProjectConfigBuildOnly -> Flag Bool
projectConfigOfflineMode :: ProjectConfigBuildOnly -> Flag Bool
projectConfigKeepGoing :: ProjectConfigBuildOnly -> Flag Bool
projectConfigNumJobs :: ProjectConfigBuildOnly -> Flag (Maybe Int)
projectConfigSymlinkBinDir :: ProjectConfigBuildOnly -> Flag String
projectConfigReportPlanningFailure :: ProjectConfigBuildOnly -> Flag Bool
projectConfigBuildReports :: ProjectConfigBuildOnly -> Flag ReportLevel
projectConfigLogFile :: ProjectConfigBuildOnly -> Flag PathTemplate
projectConfigSummaryFile :: ProjectConfigBuildOnly -> NubList PathTemplate
projectConfigOnlyDownload :: ProjectConfigBuildOnly -> Flag Bool
projectConfigOnlyDeps :: ProjectConfigBuildOnly -> Flag Bool
projectConfigDryRun :: ProjectConfigBuildOnly -> Flag Bool
projectConfigVerbosity :: ProjectConfigBuildOnly -> Flag Verbosity
..} = ProjectConfigBuildOnly
defaults
forall a. Semigroup a => a -> a -> a
<> ProjectConfigBuildOnly
projectConfigBuildOnly
defaults :: ProjectConfigBuildOnly
defaults = forall a. Monoid a => a
mempty {
projectConfigDryRun :: Flag Bool
projectConfigDryRun = forall a. a -> Flag a
toFlag Bool
False,
projectConfigOnlyDeps :: Flag Bool
projectConfigOnlyDeps = forall a. a -> Flag a
toFlag Bool
False,
projectConfigOnlyDownload :: Flag Bool
projectConfigOnlyDownload = forall a. a -> Flag a
toFlag Bool
False,
projectConfigBuildReports :: Flag ReportLevel
projectConfigBuildReports = forall a. a -> Flag a
toFlag ReportLevel
NoReports,
projectConfigReportPlanningFailure :: Flag Bool
projectConfigReportPlanningFailure = forall a. a -> Flag a
toFlag Bool
False,
projectConfigKeepGoing :: Flag Bool
projectConfigKeepGoing = forall a. a -> Flag a
toFlag Bool
False,
projectConfigOfflineMode :: Flag Bool
projectConfigOfflineMode = forall a. a -> Flag a
toFlag Bool
False,
projectConfigKeepTempFiles :: Flag Bool
projectConfigKeepTempFiles = forall a. a -> Flag a
toFlag Bool
False,
projectConfigIgnoreExpiry :: Flag Bool
projectConfigIgnoreExpiry = forall a. a -> Flag a
toFlag Bool
False
}
buildSettingLogFile :: Maybe (Compiler -> Platform
-> PackageId -> UnitId -> FilePath)
buildSettingLogFile :: Maybe (Compiler -> Platform -> PackageId -> UnitId -> String)
buildSettingLogFile
| Bool
useDefaultTemplate = forall a. a -> Maybe a
Just (PathTemplate
-> Compiler -> Platform -> PackageId -> UnitId -> String
substLogFileName PathTemplate
defaultTemplate)
| Bool
otherwise = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathTemplate
-> Compiler -> Platform -> PackageId -> UnitId -> String
substLogFileName Maybe PathTemplate
givenTemplate
defaultTemplate :: PathTemplate
defaultTemplate = String -> PathTemplate
toPathTemplate forall a b. (a -> b) -> a -> b
$
String
cabalLogsDirectory String -> String -> String
</>
String
"$compiler" String -> String -> String
</> String
"$libname" String -> String -> String
<.> String
"log"
givenTemplate :: Maybe PathTemplate
givenTemplate = forall a. Flag a -> Maybe a
flagToMaybe Flag PathTemplate
projectConfigLogFile
useDefaultTemplate :: Bool
useDefaultTemplate
| ReportLevel
buildSettingBuildReports forall a. Eq a => a -> a -> Bool
== ReportLevel
DetailedReports = Bool
True
| forall a. Maybe a -> Bool
isJust Maybe PathTemplate
givenTemplate = Bool
False
| Bool
isParallelBuild = Bool
True
| Bool
otherwise = Bool
False
isParallelBuild :: Bool
isParallelBuild = Int
buildSettingNumJobs forall a. Ord a => a -> a -> Bool
>= Int
2
substLogFileName :: PathTemplate
-> Compiler -> Platform
-> PackageId -> UnitId -> FilePath
substLogFileName :: PathTemplate
-> Compiler -> Platform -> PackageId -> UnitId -> String
substLogFileName PathTemplate
template Compiler
compiler Platform
platform PackageId
pkgid UnitId
uid =
PathTemplate -> String
fromPathTemplate (PathTemplateEnv -> PathTemplate -> PathTemplate
substPathTemplate PathTemplateEnv
env PathTemplate
template)
where
env :: PathTemplateEnv
env = PackageId -> UnitId -> CompilerInfo -> Platform -> PathTemplateEnv
initialPathTemplateEnv
PackageId
pkgid UnitId
uid (Compiler -> CompilerInfo
compilerInfo Compiler
compiler) Platform
platform
buildSettingLogVerbosity :: Verbosity
buildSettingLogVerbosity :: Verbosity
buildSettingLogVerbosity
| Bool
overrideVerbosity = (Verbosity -> Verbosity) -> Verbosity -> Verbosity
modifyVerbosity (forall a. Ord a => a -> a -> a
max Verbosity
verbose) Verbosity
verbosity
| Bool
otherwise = Verbosity
verbosity
overrideVerbosity :: Bool
overrideVerbosity :: Bool
overrideVerbosity
| ReportLevel
buildSettingBuildReports forall a. Eq a => a -> a -> Bool
== ReportLevel
DetailedReports = Bool
True
| forall a. Maybe a -> Bool
isJust Maybe PathTemplate
givenTemplate = Bool
True
| Bool
isParallelBuild = Bool
False
| Bool
otherwise = Bool
False
findProjectRoot :: Maybe FilePath
-> Maybe FilePath
-> IO (Either BadProjectRoot ProjectRoot)
findProjectRoot :: Maybe String
-> Maybe String -> IO (Either BadProjectRoot ProjectRoot)
findProjectRoot Maybe String
_ (Just String
projectFile)
| String -> Bool
isAbsolute String
projectFile = do
Bool
exists <- String -> IO Bool
doesFileExist String
projectFile
if Bool
exists
then do String
projectFile' <- String -> IO String
canonicalizePath String
projectFile
let projectRoot :: ProjectRoot
projectRoot = String -> String -> ProjectRoot
ProjectRootExplicit (String -> String
takeDirectory String
projectFile')
(String -> String
takeFileName String
projectFile')
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right ProjectRoot
projectRoot)
else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String -> BadProjectRoot
BadProjectRootExplicitFile String
projectFile))
findProjectRoot Maybe String
mstartdir Maybe String
mprojectFile = do
String
startdir <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
getCurrentDirectory String -> IO String
canonicalizePath Maybe String
mstartdir
String
homedir <- IO String
getHomeDirectory
String -> String -> IO (Either BadProjectRoot ProjectRoot)
probe String
startdir String
homedir
where
projectFileName :: String
projectFileName :: String
projectFileName = forall a. a -> Maybe a -> a
fromMaybe String
"cabal.project" Maybe String
mprojectFile
probe :: FilePath -> String -> IO (Either BadProjectRoot ProjectRoot)
probe :: String -> String -> IO (Either BadProjectRoot ProjectRoot)
probe String
startdir String
homedir = String -> IO (Either BadProjectRoot ProjectRoot)
go String
startdir
where
go :: FilePath -> IO (Either BadProjectRoot ProjectRoot)
go :: String -> IO (Either BadProjectRoot ProjectRoot)
go String
dir | String -> Bool
isDrive String
dir Bool -> Bool -> Bool
|| String
dir forall a. Eq a => a -> a -> Bool
== String
homedir =
case Maybe String
mprojectFile of
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (String -> ProjectRoot
ProjectRootImplicit String
startdir))
Just String
file -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String -> BadProjectRoot
BadProjectRootExplicitFile String
file))
go String
dir = do
Bool
exists <- String -> IO Bool
doesFileExist (String
dir String -> String -> String
</> String
projectFileName)
if Bool
exists
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (String -> String -> ProjectRoot
ProjectRootExplicit String
dir String
projectFileName))
else String -> IO (Either BadProjectRoot ProjectRoot)
go (String -> String
takeDirectory String
dir)
data BadProjectRoot = BadProjectRootExplicitFile FilePath
#if MIN_VERSION_base(4,8,0)
deriving (Int -> BadProjectRoot -> String -> String
[BadProjectRoot] -> String -> String
BadProjectRoot -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [BadProjectRoot] -> String -> String
$cshowList :: [BadProjectRoot] -> String -> String
show :: BadProjectRoot -> String
$cshow :: BadProjectRoot -> String
showsPrec :: Int -> BadProjectRoot -> String -> String
$cshowsPrec :: Int -> BadProjectRoot -> String -> String
Show, Typeable)
#else
deriving (Typeable)
instance Show BadProjectRoot where
show = renderBadProjectRoot
#endif
instance Exception BadProjectRoot where
#if MIN_VERSION_base(4,8,0)
displayException :: BadProjectRoot -> String
displayException = BadProjectRoot -> String
renderBadProjectRoot
#endif
renderBadProjectRoot :: BadProjectRoot -> String
renderBadProjectRoot :: BadProjectRoot -> String
renderBadProjectRoot (BadProjectRootExplicitFile String
projectFile) =
String
"The given project file '" forall a. [a] -> [a] -> [a]
++ String
projectFile forall a. [a] -> [a] -> [a]
++ String
"' does not exist."
withProjectOrGlobalConfig
:: Verbosity
-> Flag Bool
-> Flag FilePath
-> IO a
-> (ProjectConfig -> IO a)
-> IO a
withProjectOrGlobalConfig :: forall a.
Verbosity
-> Flag Bool
-> Flag String
-> IO a
-> (ProjectConfig -> IO a)
-> IO a
withProjectOrGlobalConfig Verbosity
verbosity (Flag Bool
True) Flag String
gcf IO a
_with ProjectConfig -> IO a
without = do
ProjectConfig
globalConfig <- forall a. String -> Rebuild a -> IO a
runRebuild String
"" forall a b. (a -> b) -> a -> b
$ Verbosity -> Flag String -> Rebuild ProjectConfig
readGlobalConfig Verbosity
verbosity Flag String
gcf
ProjectConfig -> IO a
without ProjectConfig
globalConfig
withProjectOrGlobalConfig Verbosity
verbosity Flag Bool
_ignorePrj Flag String
gcf IO a
with ProjectConfig -> IO a
without =
forall a.
Verbosity -> Flag String -> IO a -> (ProjectConfig -> IO a) -> IO a
withProjectOrGlobalConfig' Verbosity
verbosity Flag String
gcf IO a
with ProjectConfig -> IO a
without
withProjectOrGlobalConfig'
:: Verbosity
-> Flag FilePath
-> IO a
-> (ProjectConfig -> IO a)
-> IO a
withProjectOrGlobalConfig' :: forall a.
Verbosity -> Flag String -> IO a -> (ProjectConfig -> IO a) -> IO a
withProjectOrGlobalConfig' Verbosity
verbosity Flag String
globalConfigFlag IO a
with ProjectConfig -> IO a
without = do
ProjectConfig
globalConfig <- forall a. String -> Rebuild a -> IO a
runRebuild String
"" forall a b. (a -> b) -> a -> b
$ Verbosity -> Flag String -> Rebuild ProjectConfig
readGlobalConfig Verbosity
verbosity Flag String
globalConfigFlag
let
res' :: IO a
res' = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO a
with
forall a b. (a -> b) -> a -> b
$ \case
(BadPackageLocations Set ProjectConfigProvenance
prov [BadPackageLocation]
locs)
| Set ProjectConfigProvenance
prov forall a. Eq a => a -> a -> Bool
== forall a. a -> Set a
Set.singleton ProjectConfigProvenance
Implicit
, let
isGlobErr :: BadPackageLocation -> Bool
isGlobErr (BadLocGlobEmptyMatch String
_) = Bool
True
isGlobErr BadPackageLocation
_ = Bool
False
, forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any BadPackageLocation -> Bool
isGlobErr [BadPackageLocation]
locs ->
ProjectConfig -> IO a
without ProjectConfig
globalConfig
BadPackageLocations
err -> forall e a. Exception e => e -> IO a
throwIO BadPackageLocations
err
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO a
res'
forall a b. (a -> b) -> a -> b
$ \case
(BadProjectRootExplicitFile String
"") -> ProjectConfig -> IO a
without ProjectConfig
globalConfig
BadProjectRoot
err -> forall e a. Exception e => e -> IO a
throwIO BadProjectRoot
err
readProjectConfig :: Verbosity
-> HttpTransport
-> Flag Bool
-> Flag FilePath
-> DistDirLayout
-> Rebuild ProjectConfigSkeleton
readProjectConfig :: Verbosity
-> HttpTransport
-> Flag Bool
-> Flag String
-> DistDirLayout
-> Rebuild ProjectConfigSkeleton
readProjectConfig Verbosity
verbosity HttpTransport
httpTransport Flag Bool
ignoreProjectFlag Flag String
configFileFlag DistDirLayout
distDirLayout = do
ProjectConfigSkeleton
global <- ProjectConfig -> ProjectConfigSkeleton
singletonProjectConfigSkeleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity -> Flag String -> Rebuild ProjectConfig
readGlobalConfig Verbosity
verbosity Flag String
configFileFlag
ProjectConfigSkeleton
local <- Verbosity
-> HttpTransport -> DistDirLayout -> Rebuild ProjectConfigSkeleton
readProjectLocalConfigOrDefault Verbosity
verbosity HttpTransport
httpTransport DistDirLayout
distDirLayout
ProjectConfigSkeleton
freeze <- Verbosity
-> HttpTransport -> DistDirLayout -> Rebuild ProjectConfigSkeleton
readProjectLocalFreezeConfig Verbosity
verbosity HttpTransport
httpTransport DistDirLayout
distDirLayout
ProjectConfigSkeleton
extra <- Verbosity
-> HttpTransport -> DistDirLayout -> Rebuild ProjectConfigSkeleton
readProjectLocalExtraConfig Verbosity
verbosity HttpTransport
httpTransport DistDirLayout
distDirLayout
if Flag Bool
ignoreProjectFlag forall a. Eq a => a -> a -> Bool
== forall a. a -> Flag a
Flag Bool
True then forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectConfigSkeleton
global forall a. Semigroup a => a -> a -> a
<> (ProjectConfig -> ProjectConfigSkeleton
singletonProjectConfigSkeleton ProjectConfig
defaultProject))
else forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectConfigSkeleton
global forall a. Semigroup a => a -> a -> a
<> ProjectConfigSkeleton
local forall a. Semigroup a => a -> a -> a
<> ProjectConfigSkeleton
freeze forall a. Semigroup a => a -> a -> a
<> ProjectConfigSkeleton
extra)
where
defaultProject :: ProjectConfig
defaultProject :: ProjectConfig
defaultProject = forall a. Monoid a => a
mempty {
projectPackages :: [String]
projectPackages = [String
"./"]
}
readProjectLocalConfigOrDefault :: Verbosity
-> HttpTransport
-> DistDirLayout
-> Rebuild ProjectConfigSkeleton
readProjectLocalConfigOrDefault :: Verbosity
-> HttpTransport -> DistDirLayout -> Rebuild ProjectConfigSkeleton
readProjectLocalConfigOrDefault Verbosity
verbosity HttpTransport
httpTransport DistDirLayout
distDirLayout = do
Bool
usesExplicitProjectRoot <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
projectFile
if Bool
usesExplicitProjectRoot
then do
Verbosity
-> HttpTransport
-> DistDirLayout
-> String
-> String
-> Rebuild ProjectConfigSkeleton
readProjectFileSkeleton Verbosity
verbosity HttpTransport
httpTransport DistDirLayout
distDirLayout String
"" String
"project file"
else do
[MonitorFilePath] -> Rebuild ()
monitorFiles [String -> MonitorFilePath
monitorNonExistentFile String
projectFile]
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectConfig -> ProjectConfigSkeleton
singletonProjectConfigSkeleton ProjectConfig
defaultImplicitProjectConfig)
where
projectFile :: FilePath
projectFile :: String
projectFile = DistDirLayout -> String -> String
distProjectFile DistDirLayout
distDirLayout String
""
defaultImplicitProjectConfig :: ProjectConfig
defaultImplicitProjectConfig :: ProjectConfig
defaultImplicitProjectConfig = forall a. Monoid a => a
mempty {
projectPackages :: [String]
projectPackages = [ String
"./*.cabal" ],
projectConfigProvenance :: Set ProjectConfigProvenance
projectConfigProvenance = forall a. a -> Set a
Set.singleton ProjectConfigProvenance
Implicit
}
readProjectLocalExtraConfig :: Verbosity -> HttpTransport -> DistDirLayout
-> Rebuild ProjectConfigSkeleton
Verbosity
verbosity HttpTransport
httpTransport DistDirLayout
distDirLayout =
Verbosity
-> HttpTransport
-> DistDirLayout
-> String
-> String
-> Rebuild ProjectConfigSkeleton
readProjectFileSkeleton Verbosity
verbosity HttpTransport
httpTransport DistDirLayout
distDirLayout String
"local"
String
"project local configuration file"
readProjectLocalFreezeConfig :: Verbosity -> HttpTransport ->DistDirLayout
-> Rebuild ProjectConfigSkeleton
readProjectLocalFreezeConfig :: Verbosity
-> HttpTransport -> DistDirLayout -> Rebuild ProjectConfigSkeleton
readProjectLocalFreezeConfig Verbosity
verbosity HttpTransport
httpTransport DistDirLayout
distDirLayout =
Verbosity
-> HttpTransport
-> DistDirLayout
-> String
-> String
-> Rebuild ProjectConfigSkeleton
readProjectFileSkeleton Verbosity
verbosity HttpTransport
httpTransport DistDirLayout
distDirLayout String
"freeze"
String
"project freeze file"
readProjectFileSkeleton :: Verbosity -> HttpTransport -> DistDirLayout -> String -> String -> Rebuild ProjectConfigSkeleton
readProjectFileSkeleton :: Verbosity
-> HttpTransport
-> DistDirLayout
-> String
-> String
-> Rebuild ProjectConfigSkeleton
readProjectFileSkeleton Verbosity
verbosity HttpTransport
httpTransport DistDirLayout{String -> String
distProjectFile :: String -> String
distProjectFile :: DistDirLayout -> String -> String
distProjectFile, String
distDownloadSrcDirectory :: DistDirLayout -> String
distDownloadSrcDirectory :: String
distDownloadSrcDirectory}
String
extensionName String
extensionDescription = do
Bool
exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
extensionFile
if Bool
exists
then do [MonitorFilePath] -> Rebuild ()
monitorFiles [String -> MonitorFilePath
monitorFileHashed String
extensionFile]
ProjectConfigSkeleton
pcs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ProjectConfigSkeleton
readExtensionFile
[MonitorFilePath] -> Rebuild ()
monitorFiles forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> MonitorFilePath
monitorFileHashed (ProjectConfigSkeleton -> [String]
projectSkeletonImports ProjectConfigSkeleton
pcs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectConfigSkeleton
pcs
else do [MonitorFilePath] -> Rebuild ()
monitorFiles [String -> MonitorFilePath
monitorNonExistentFile String
extensionFile]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
where
extensionFile :: String
extensionFile = String -> String
distProjectFile String
extensionName
readExtensionFile :: IO ProjectConfigSkeleton
readExtensionFile =
Verbosity
-> String
-> String
-> ParseResult ProjectConfigSkeleton
-> IO ProjectConfigSkeleton
reportParseResult Verbosity
verbosity String
extensionDescription String
extensionFile
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String
-> HttpTransport
-> Verbosity
-> [String]
-> String
-> ByteString
-> IO (ParseResult ProjectConfigSkeleton)
parseProjectSkeleton String
distDownloadSrcDirectory HttpTransport
httpTransport Verbosity
verbosity [] String
extensionFile
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ByteString
BS.readFile String
extensionFile
showProjectConfig :: ProjectConfig -> String
showProjectConfig :: ProjectConfig -> String
showProjectConfig =
LegacyProjectConfig -> String
showLegacyProjectConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfig -> LegacyProjectConfig
convertToLegacyProjectConfig
writeProjectLocalExtraConfig :: DistDirLayout -> ProjectConfig -> IO ()
DistDirLayout{String -> String
distProjectFile :: String -> String
distProjectFile :: DistDirLayout -> String -> String
distProjectFile} =
String -> ProjectConfig -> IO ()
writeProjectConfigFile (String -> String
distProjectFile String
"local")
writeProjectLocalFreezeConfig :: DistDirLayout -> ProjectConfig -> IO ()
writeProjectLocalFreezeConfig :: DistDirLayout -> ProjectConfig -> IO ()
writeProjectLocalFreezeConfig DistDirLayout{String -> String
distProjectFile :: String -> String
distProjectFile :: DistDirLayout -> String -> String
distProjectFile} =
String -> ProjectConfig -> IO ()
writeProjectConfigFile (String -> String
distProjectFile String
"freeze")
writeProjectConfigFile :: FilePath -> ProjectConfig -> IO ()
writeProjectConfigFile :: String -> ProjectConfig -> IO ()
writeProjectConfigFile String
file =
String -> String -> IO ()
writeFile String
file forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfig -> String
showProjectConfig
readGlobalConfig :: Verbosity -> Flag FilePath -> Rebuild ProjectConfig
readGlobalConfig :: Verbosity -> Flag String -> Rebuild ProjectConfig
readGlobalConfig Verbosity
verbosity Flag String
configFileFlag = do
SavedConfig
config <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Verbosity -> Flag String -> IO SavedConfig
loadConfig Verbosity
verbosity Flag String
configFileFlag)
String
configFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Flag String -> IO String
getConfigFilePath Flag String
configFileFlag)
[MonitorFilePath] -> Rebuild ()
monitorFiles [String -> MonitorFilePath
monitorFileHashed String
configFile]
forall (m :: * -> *) a. Monad m => a -> m a
return (SavedConfig -> ProjectConfig
convertLegacyGlobalConfig SavedConfig
config)
reportParseResult :: Verbosity -> String -> FilePath -> OldParser.ParseResult ProjectConfigSkeleton -> IO ProjectConfigSkeleton
reportParseResult :: Verbosity
-> String
-> String
-> ParseResult ProjectConfigSkeleton
-> IO ProjectConfigSkeleton
reportParseResult Verbosity
verbosity String
_filetype String
filename (OldParser.ParseOk [PWarning]
warnings ProjectConfigSkeleton
x) = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PWarning]
warnings) forall a b. (a -> b) -> a -> b
$
let msg :: String
msg = [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (String -> PWarning -> String
OldParser.showPWarning (forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall a b. (a -> b) -> a -> b
$ String
filename forall a. a -> [a] -> [a]
: ProjectConfigSkeleton -> [String]
projectSkeletonImports ProjectConfigSkeleton
x)) [PWarning]
warnings)
in Verbosity -> String -> IO ()
warn Verbosity
verbosity String
msg
forall (m :: * -> *) a. Monad m => a -> m a
return ProjectConfigSkeleton
x
reportParseResult Verbosity
verbosity String
filetype String
filename (OldParser.ParseFailed PError
err) =
let (Maybe Int
line, String
msg) = PError -> (Maybe Int, String)
OldParser.locatedErrorMsg PError
err
in forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Error parsing " forall a. [a] -> [a] -> [a]
++ String
filetype forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
filename
forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Int
n -> Char
':' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
n) Maybe Int
line forall a. [a] -> [a] -> [a]
++ String
":\n" forall a. [a] -> [a] -> [a]
++ String
msg
data ProjectPackageLocation =
ProjectPackageLocalCabalFile FilePath
| ProjectPackageLocalDirectory FilePath FilePath
| ProjectPackageLocalTarball FilePath
| ProjectPackageRemoteTarball URI
| ProjectPackageRemoteRepo SourceRepoList
| ProjectPackageNamed PackageVersionConstraint
deriving Int -> ProjectPackageLocation -> String -> String
[ProjectPackageLocation] -> String -> String
ProjectPackageLocation -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ProjectPackageLocation] -> String -> String
$cshowList :: [ProjectPackageLocation] -> String -> String
show :: ProjectPackageLocation -> String
$cshow :: ProjectPackageLocation -> String
showsPrec :: Int -> ProjectPackageLocation -> String -> String
$cshowsPrec :: Int -> ProjectPackageLocation -> String -> String
Show
data BadPackageLocations
= BadPackageLocations (Set ProjectConfigProvenance) [BadPackageLocation]
#if MIN_VERSION_base(4,8,0)
deriving (Int -> BadPackageLocations -> String -> String
[BadPackageLocations] -> String -> String
BadPackageLocations -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [BadPackageLocations] -> String -> String
$cshowList :: [BadPackageLocations] -> String -> String
show :: BadPackageLocations -> String
$cshow :: BadPackageLocations -> String
showsPrec :: Int -> BadPackageLocations -> String -> String
$cshowsPrec :: Int -> BadPackageLocations -> String -> String
Show, Typeable)
#else
deriving (Typeable)
instance Show BadPackageLocations where
show = renderBadPackageLocations
#endif
instance Exception BadPackageLocations where
#if MIN_VERSION_base(4,8,0)
displayException :: BadPackageLocations -> String
displayException = BadPackageLocations -> String
renderBadPackageLocations
#endif
data BadPackageLocation
= BadPackageLocationFile BadPackageLocationMatch
| BadLocGlobEmptyMatch String
| BadLocGlobBadMatches String [BadPackageLocationMatch]
| BadLocUnexpectedUriScheme String
| BadLocUnrecognisedUri String
| BadLocUnrecognised String
deriving Int -> BadPackageLocation -> String -> String
[BadPackageLocation] -> String -> String
BadPackageLocation -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [BadPackageLocation] -> String -> String
$cshowList :: [BadPackageLocation] -> String -> String
show :: BadPackageLocation -> String
$cshow :: BadPackageLocation -> String
showsPrec :: Int -> BadPackageLocation -> String -> String
$cshowsPrec :: Int -> BadPackageLocation -> String -> String
Show
data BadPackageLocationMatch
= BadLocUnexpectedFile String
| BadLocNonexistantFile String
| BadLocDirNoCabalFile String
| BadLocDirManyCabalFiles String
deriving Int -> BadPackageLocationMatch -> String -> String
[BadPackageLocationMatch] -> String -> String
BadPackageLocationMatch -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [BadPackageLocationMatch] -> String -> String
$cshowList :: [BadPackageLocationMatch] -> String -> String
show :: BadPackageLocationMatch -> String
$cshow :: BadPackageLocationMatch -> String
showsPrec :: Int -> BadPackageLocationMatch -> String -> String
$cshowsPrec :: Int -> BadPackageLocationMatch -> String -> String
Show
renderBadPackageLocations :: BadPackageLocations -> String
renderBadPackageLocations :: BadPackageLocations -> String
renderBadPackageLocations (BadPackageLocations Set ProjectConfigProvenance
provenance [BadPackageLocation]
bpls)
| forall a. Set a -> Bool
Set.null Set ProjectConfigProvenance
provenance = (BadPackageLocation -> String) -> String
renderErrors BadPackageLocation -> String
renderBadPackageLocation
| forall a. a -> Set a
Set.singleton ProjectConfigProvenance
Implicit forall a. Eq a => a -> a -> Bool
== Set ProjectConfigProvenance
provenance =
(BadPackageLocation -> String) -> String
renderErrors BadPackageLocation -> String
renderImplicitBadPackageLocation
| ProjectConfigProvenance
Implicit forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ProjectConfigProvenance
provenance =
String
"Warning: both implicit and explicit configuration is present."
forall a. [a] -> [a] -> [a]
++ String
renderExplicit
| Bool
otherwise = String
renderExplicit
where
renderErrors :: (BadPackageLocation -> String) -> String
renderErrors BadPackageLocation -> String
f = [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map BadPackageLocation -> String
f [BadPackageLocation]
bpls)
renderExplicit :: String
renderExplicit =
String
"When using configuration(s) from "
forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ProjectConfigProvenance -> Maybe String
getExplicit (forall a. Set a -> [a]
Set.toList Set ProjectConfigProvenance
provenance))
forall a. [a] -> [a] -> [a]
++ String
", the following errors occurred:\n"
forall a. [a] -> [a] -> [a]
++ (BadPackageLocation -> String) -> String
renderErrors BadPackageLocation -> String
renderBadPackageLocation
getExplicit :: ProjectConfigProvenance -> Maybe String
getExplicit (Explicit String
path) = forall a. a -> Maybe a
Just String
path
getExplicit ProjectConfigProvenance
Implicit = forall a. Maybe a
Nothing
renderImplicitBadPackageLocation :: BadPackageLocation -> String
renderImplicitBadPackageLocation :: BadPackageLocation -> String
renderImplicitBadPackageLocation BadPackageLocation
bpl = case BadPackageLocation
bpl of
BadLocGlobEmptyMatch String
pkglocstr ->
String
"No cabal.project file or cabal file matching the default glob '"
forall a. [a] -> [a] -> [a]
++ String
pkglocstr forall a. [a] -> [a] -> [a]
++ String
"' was found.\n"
forall a. [a] -> [a] -> [a]
++ String
"Please create a package description file <pkgname>.cabal "
forall a. [a] -> [a] -> [a]
++ String
"or a cabal.project file referencing the packages you "
forall a. [a] -> [a] -> [a]
++ String
"want to build."
BadPackageLocation
_ -> BadPackageLocation -> String
renderBadPackageLocation BadPackageLocation
bpl
renderBadPackageLocation :: BadPackageLocation -> String
renderBadPackageLocation :: BadPackageLocation -> String
renderBadPackageLocation BadPackageLocation
bpl = case BadPackageLocation
bpl of
BadPackageLocationFile BadPackageLocationMatch
badmatch ->
BadPackageLocationMatch -> String
renderBadPackageLocationMatch BadPackageLocationMatch
badmatch
BadLocGlobEmptyMatch String
pkglocstr ->
String
"The package location glob '" forall a. [a] -> [a] -> [a]
++ String
pkglocstr
forall a. [a] -> [a] -> [a]
++ String
"' does not match any files or directories."
BadLocGlobBadMatches String
pkglocstr [BadPackageLocationMatch]
failures ->
String
"The package location glob '" forall a. [a] -> [a] -> [a]
++ String
pkglocstr forall a. [a] -> [a] -> [a]
++ String
"' does not match any "
forall a. [a] -> [a] -> [a]
++ String
"recognised forms of package. "
forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char
' 'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. BadPackageLocationMatch -> String
renderBadPackageLocationMatch) [BadPackageLocationMatch]
failures
BadLocUnexpectedUriScheme String
pkglocstr ->
String
"The package location URI '" forall a. [a] -> [a] -> [a]
++ String
pkglocstr forall a. [a] -> [a] -> [a]
++ String
"' does not use a "
forall a. [a] -> [a] -> [a]
++ String
"supported URI scheme. The supported URI schemes are http, https and "
forall a. [a] -> [a] -> [a]
++ String
"file."
BadLocUnrecognisedUri String
pkglocstr ->
String
"The package location URI '" forall a. [a] -> [a] -> [a]
++ String
pkglocstr forall a. [a] -> [a] -> [a]
++ String
"' does not appear to "
forall a. [a] -> [a] -> [a]
++ String
"be a valid absolute URI."
BadLocUnrecognised String
pkglocstr ->
String
"The package location syntax '" forall a. [a] -> [a] -> [a]
++ String
pkglocstr forall a. [a] -> [a] -> [a]
++ String
"' is not recognised."
renderBadPackageLocationMatch :: BadPackageLocationMatch -> String
renderBadPackageLocationMatch :: BadPackageLocationMatch -> String
renderBadPackageLocationMatch BadPackageLocationMatch
bplm = case BadPackageLocationMatch
bplm of
BadLocUnexpectedFile String
pkglocstr ->
String
"The package location '" forall a. [a] -> [a] -> [a]
++ String
pkglocstr forall a. [a] -> [a] -> [a]
++ String
"' is not recognised. The "
forall a. [a] -> [a] -> [a]
++ String
"supported file targets are .cabal files, .tar.gz tarballs or package "
forall a. [a] -> [a] -> [a]
++ String
"directories (i.e. directories containing a .cabal file)."
BadLocNonexistantFile String
pkglocstr ->
String
"The package location '" forall a. [a] -> [a] -> [a]
++ String
pkglocstr forall a. [a] -> [a] -> [a]
++ String
"' does not exist."
BadLocDirNoCabalFile String
pkglocstr ->
String
"The package directory '" forall a. [a] -> [a] -> [a]
++ String
pkglocstr forall a. [a] -> [a] -> [a]
++ String
"' does not contain any "
forall a. [a] -> [a] -> [a]
++ String
".cabal file."
BadLocDirManyCabalFiles String
pkglocstr ->
String
"The package directory '" forall a. [a] -> [a] -> [a]
++ String
pkglocstr forall a. [a] -> [a] -> [a]
++ String
"' contains multiple "
forall a. [a] -> [a] -> [a]
++ String
".cabal files (which is not currently supported)."
findProjectPackages :: DistDirLayout -> ProjectConfig
-> Rebuild [ProjectPackageLocation]
findProjectPackages :: DistDirLayout -> ProjectConfig -> Rebuild [ProjectPackageLocation]
findProjectPackages DistDirLayout{String
distProjectRootDirectory :: DistDirLayout -> String
distProjectRootDirectory :: String
distProjectRootDirectory}
ProjectConfig{[String]
[PackageVersionConstraint]
[SourceRepoList]
Set ProjectConfigProvenance
MapMappend PackageName PackageConfig
PackageConfig
ProjectConfigShared
ProjectConfigBuildOnly
projectConfigAllPackages :: ProjectConfig -> PackageConfig
projectPackagesNamed :: ProjectConfig -> [PackageVersionConstraint]
projectPackagesRepo :: ProjectConfig -> [SourceRepoList]
projectPackagesOptional :: ProjectConfig -> [String]
projectConfigSpecificPackage :: MapMappend PackageName PackageConfig
projectConfigLocalPackages :: PackageConfig
projectConfigAllPackages :: PackageConfig
projectConfigProvenance :: Set ProjectConfigProvenance
projectConfigShared :: ProjectConfigShared
projectConfigBuildOnly :: ProjectConfigBuildOnly
projectPackagesNamed :: [PackageVersionConstraint]
projectPackagesRepo :: [SourceRepoList]
projectPackagesOptional :: [String]
projectPackages :: [String]
projectConfigProvenance :: ProjectConfig -> Set ProjectConfigProvenance
projectPackages :: ProjectConfig -> [String]
projectConfigBuildOnly :: ProjectConfig -> ProjectConfigBuildOnly
projectConfigShared :: ProjectConfig -> ProjectConfigShared
projectConfigSpecificPackage :: ProjectConfig -> MapMappend PackageName PackageConfig
projectConfigLocalPackages :: ProjectConfig -> PackageConfig
..} = do
[ProjectPackageLocation]
requiredPkgs <- Bool -> [String] -> Rebuild [ProjectPackageLocation]
findPackageLocations Bool
True [String]
projectPackages
[ProjectPackageLocation]
optionalPkgs <- Bool -> [String] -> Rebuild [ProjectPackageLocation]
findPackageLocations Bool
False [String]
projectPackagesOptional
let repoPkgs :: [ProjectPackageLocation]
repoPkgs = forall a b. (a -> b) -> [a] -> [b]
map SourceRepoList -> ProjectPackageLocation
ProjectPackageRemoteRepo [SourceRepoList]
projectPackagesRepo
namedPkgs :: [ProjectPackageLocation]
namedPkgs = forall a b. (a -> b) -> [a] -> [b]
map PackageVersionConstraint -> ProjectPackageLocation
ProjectPackageNamed [PackageVersionConstraint]
projectPackagesNamed
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ProjectPackageLocation]
requiredPkgs, [ProjectPackageLocation]
optionalPkgs, [ProjectPackageLocation]
repoPkgs, [ProjectPackageLocation]
namedPkgs])
where
findPackageLocations :: Bool -> [String] -> Rebuild [ProjectPackageLocation]
findPackageLocations :: Bool -> [String] -> Rebuild [ProjectPackageLocation]
findPackageLocations Bool
required [String]
pkglocstr = do
([BadPackageLocation]
problems, [[ProjectPackageLocation]]
pkglocs) <-
forall a b. [Either a b] -> ([a], [b])
partitionEithers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Bool
-> String
-> Rebuild (Either BadPackageLocation [ProjectPackageLocation])
findPackageLocation Bool
required) [String]
pkglocstr
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BadPackageLocation]
problems) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Set ProjectConfigProvenance
-> [BadPackageLocation] -> BadPackageLocations
BadPackageLocations Set ProjectConfigProvenance
projectConfigProvenance [BadPackageLocation]
problems
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ProjectPackageLocation]]
pkglocs)
findPackageLocation :: Bool -> String
-> Rebuild (Either BadPackageLocation
[ProjectPackageLocation])
findPackageLocation :: Bool
-> String
-> Rebuild (Either BadPackageLocation [ProjectPackageLocation])
findPackageLocation _required :: Bool
_required@Bool
True String
pkglocstr =
String
-> Rebuild
(Maybe (Either BadPackageLocation [ProjectPackageLocation]))
checkIsUriPackage String
pkglocstr
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> m (Maybe a) -> m (Maybe a)
`mplusMaybeT` String
-> Rebuild
(Maybe (Either BadPackageLocation [ProjectPackageLocation]))
checkIsFileGlobPackage String
pkglocstr
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> m (Maybe a) -> m (Maybe a)
`mplusMaybeT` String
-> Rebuild
(Maybe (Either BadPackageLocation [ProjectPackageLocation]))
checkIsSingleFilePackage String
pkglocstr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String -> BadPackageLocation
BadLocUnrecognised String
pkglocstr))) forall (m :: * -> *) a. Monad m => a -> m a
return
findPackageLocation _required :: Bool
_required@Bool
False String
pkglocstr = do
Maybe (Either BadPackageLocation [ProjectPackageLocation])
res <- String
-> Rebuild
(Maybe (Either BadPackageLocation [ProjectPackageLocation]))
checkIsFileGlobPackage String
pkglocstr
case Maybe (Either BadPackageLocation [ProjectPackageLocation])
res of
Maybe (Either BadPackageLocation [ProjectPackageLocation])
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String -> BadPackageLocation
BadLocUnrecognised String
pkglocstr))
Just (Left BadPackageLocation
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right [])
Just (Right [ProjectPackageLocation]
pkglocs) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right [ProjectPackageLocation]
pkglocs)
checkIsUriPackage, checkIsFileGlobPackage, checkIsSingleFilePackage
:: String -> Rebuild (Maybe (Either BadPackageLocation
[ProjectPackageLocation]))
checkIsUriPackage :: String
-> Rebuild
(Maybe (Either BadPackageLocation [ProjectPackageLocation]))
checkIsUriPackage String
pkglocstr =
case String -> Maybe URI
parseAbsoluteURI String
pkglocstr of
Just uri :: URI
uri@URI {
uriScheme :: URI -> String
uriScheme = String
scheme,
uriAuthority :: URI -> Maybe URIAuth
uriAuthority = Just URIAuth { uriRegName :: URIAuth -> String
uriRegName = String
host },
uriPath :: URI -> String
uriPath = String
path,
uriQuery :: URI -> String
uriQuery = String
query,
uriFragment :: URI -> String
uriFragment = String
frag
}
| Bool
recognisedScheme Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
host) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right [URI -> ProjectPackageLocation
ProjectPackageRemoteTarball URI
uri]))
| String
scheme forall a. Eq a => a -> a -> Bool
== String
"file:" Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
host Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
query Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
frag ->
String
-> Rebuild
(Maybe (Either BadPackageLocation [ProjectPackageLocation]))
checkIsSingleFilePackage String
path
| Bool -> Bool
not Bool
recognisedScheme Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
host) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left (String -> BadPackageLocation
BadLocUnexpectedUriScheme String
pkglocstr)))
| Bool
recognisedScheme Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
host ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left (String -> BadPackageLocation
BadLocUnrecognisedUri String
pkglocstr)))
where
recognisedScheme :: Bool
recognisedScheme = String
scheme forall a. Eq a => a -> a -> Bool
== String
"http:" Bool -> Bool -> Bool
|| String
scheme forall a. Eq a => a -> a -> Bool
== String
"https:"
Bool -> Bool -> Bool
|| String
scheme forall a. Eq a => a -> a -> Bool
== String
"file:"
Maybe URI
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
checkIsFileGlobPackage :: String
-> Rebuild
(Maybe (Either BadPackageLocation [ProjectPackageLocation]))
checkIsFileGlobPackage String
pkglocstr =
case forall a. Parsec a => String -> Maybe a
simpleParsec String
pkglocstr of
Maybe FilePathGlob
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just FilePathGlob
glob -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
[String]
matches <- FilePathGlob -> Rebuild [String]
matchFileGlob FilePathGlob
glob
case [String]
matches of
[] | forall a. Maybe a -> Bool
isJust (FilePathGlob -> Maybe String
isTrivialFilePathGlob FilePathGlob
glob)
-> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (BadPackageLocationMatch -> BadPackageLocation
BadPackageLocationFile
(String -> BadPackageLocationMatch
BadLocNonexistantFile String
pkglocstr)))
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String -> BadPackageLocation
BadLocGlobEmptyMatch String
pkglocstr))
[String]
_ -> do
([BadPackageLocationMatch]
failures, [ProjectPackageLocation]
pkglocs) <- forall a b. [Either a b] -> ([a], [b])
partitionEithers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String
-> Rebuild (Either BadPackageLocationMatch ProjectPackageLocation)
checkFilePackageMatch [String]
matches
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! case ([BadPackageLocationMatch]
failures, [ProjectPackageLocation]
pkglocs) of
([BadPackageLocationMatch
failure], []) | forall a. Maybe a -> Bool
isJust (FilePathGlob -> Maybe String
isTrivialFilePathGlob FilePathGlob
glob)
-> forall a b. a -> Either a b
Left (BadPackageLocationMatch -> BadPackageLocation
BadPackageLocationFile BadPackageLocationMatch
failure)
([BadPackageLocationMatch]
_, []) -> forall a b. a -> Either a b
Left (String -> [BadPackageLocationMatch] -> BadPackageLocation
BadLocGlobBadMatches String
pkglocstr [BadPackageLocationMatch]
failures)
([BadPackageLocationMatch], [ProjectPackageLocation])
_ -> forall a b. b -> Either a b
Right [ProjectPackageLocation]
pkglocs
checkIsSingleFilePackage :: String
-> Rebuild
(Maybe (Either BadPackageLocation [ProjectPackageLocation]))
checkIsSingleFilePackage String
pkglocstr = do
let filename :: String
filename = String
distProjectRootDirectory String -> String -> String
</> String
pkglocstr
Bool
isFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
filename
Bool
isDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
filename
if Bool
isFile Bool -> Bool -> Bool
|| Bool
isDir
then String
-> Rebuild (Either BadPackageLocationMatch ProjectPackageLocation)
checkFilePackageMatch String
pkglocstr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. BadPackageLocationMatch -> BadPackageLocation
BadPackageLocationFile)
(forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ProjectPackageLocation
x->[ProjectPackageLocation
x]))
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
checkFilePackageMatch :: String -> Rebuild (Either BadPackageLocationMatch
ProjectPackageLocation)
checkFilePackageMatch :: String
-> Rebuild (Either BadPackageLocationMatch ProjectPackageLocation)
checkFilePackageMatch String
pkglocstr = do
let abspath :: String
abspath = String
distProjectRootDirectory String -> String -> String
</> String
pkglocstr
Bool
isFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
abspath
Bool
isDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
abspath
Bool
parentDirExists <- case String -> String
takeDirectory String
abspath of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
String
dir -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
dir
case () of
()
_ | Bool
isDir
-> do [String]
matches <- FilePathGlob -> Rebuild [String]
matchFileGlob (String -> FilePathGlob
globStarDotCabal String
pkglocstr)
case [String]
matches of
[String
cabalFile]
-> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (String -> String -> ProjectPackageLocation
ProjectPackageLocalDirectory
String
pkglocstr String
cabalFile))
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String -> BadPackageLocationMatch
BadLocDirNoCabalFile String
pkglocstr))
[String]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String -> BadPackageLocationMatch
BadLocDirManyCabalFiles String
pkglocstr))
| String -> Bool
extensionIsTarGz String
pkglocstr
-> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (String -> ProjectPackageLocation
ProjectPackageLocalTarball String
pkglocstr))
| String -> String
takeExtension String
pkglocstr forall a. Eq a => a -> a -> Bool
== String
".cabal"
-> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (String -> ProjectPackageLocation
ProjectPackageLocalCabalFile String
pkglocstr))
| Bool
isFile
-> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String -> BadPackageLocationMatch
BadLocUnexpectedFile String
pkglocstr))
| Bool
parentDirExists
-> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String -> BadPackageLocationMatch
BadLocNonexistantFile String
pkglocstr))
| Bool
otherwise
-> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String -> BadPackageLocationMatch
BadLocUnexpectedFile String
pkglocstr))
extensionIsTarGz :: String -> Bool
extensionIsTarGz String
f = String -> String
takeExtension String
f forall a. Eq a => a -> a -> Bool
== String
".gz"
Bool -> Bool -> Bool
&& String -> String
takeExtension (String -> String
dropExtension String
f) forall a. Eq a => a -> a -> Bool
== String
".tar"
globStarDotCabal :: FilePath -> FilePathGlob
globStarDotCabal :: String -> FilePathGlob
globStarDotCabal String
dir =
FilePathRoot -> FilePathGlobRel -> FilePathGlob
FilePathGlob
(if String -> Bool
isAbsolute String
dir then String -> FilePathRoot
FilePathRoot String
root else FilePathRoot
FilePathRelative)
(forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\String
d -> Glob -> FilePathGlobRel -> FilePathGlobRel
GlobDir [String -> GlobPiece
Literal String
d])
(Glob -> FilePathGlobRel
GlobFile [GlobPiece
WildCard, String -> GlobPiece
Literal String
".cabal"]) [String]
dirComponents)
where
(String
root, [String]
dirComponents) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> [String]
splitDirectories (String -> (String, String)
splitDrive String
dir)
mplusMaybeT :: Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a)
mplusMaybeT :: forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> m (Maybe a) -> m (Maybe a)
mplusMaybeT m (Maybe a)
ma m (Maybe a)
mb = do
Maybe a
mx <- m (Maybe a)
ma
case Maybe a
mx of
Maybe a
Nothing -> m (Maybe a)
mb
Just a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x)
fetchAndReadSourcePackages
:: Verbosity
-> DistDirLayout
-> ProjectConfigShared
-> ProjectConfigBuildOnly
-> [ProjectPackageLocation]
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
fetchAndReadSourcePackages :: Verbosity
-> DistDirLayout
-> ProjectConfigShared
-> ProjectConfigBuildOnly
-> [ProjectPackageLocation]
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
fetchAndReadSourcePackages Verbosity
verbosity DistDirLayout
distDirLayout
ProjectConfigShared
projectConfigShared
ProjectConfigBuildOnly
projectConfigBuildOnly
[ProjectPackageLocation]
pkgLocations = do
[PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
pkgsLocalDirectory <-
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
[ Verbosity
-> String
-> String
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
readSourcePackageLocalDirectory Verbosity
verbosity String
dir String
cabalFile
| ProjectPackageLocation
location <- [ProjectPackageLocation]
pkgLocations
, (String
dir, String
cabalFile) <- ProjectPackageLocation -> [(String, String)]
projectPackageLocal ProjectPackageLocation
location ]
[PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
pkgsLocalTarball <-
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
[ Verbosity
-> String
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
readSourcePackageLocalTarball Verbosity
verbosity String
path
| ProjectPackageLocalTarball String
path <- [ProjectPackageLocation]
pkgLocations ]
[PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
pkgsRemoteTarball <- do
Rebuild HttpTransport
getTransport <- forall a. IO a -> Rebuild (Rebuild a)
delayInitSharedResource forall a b. (a -> b) -> a -> b
$
Verbosity -> [String] -> Maybe String -> IO HttpTransport
configureTransport Verbosity
verbosity [String]
progPathExtra
Maybe String
preferredHttpTransport
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
[ Verbosity
-> DistDirLayout
-> Rebuild HttpTransport
-> URI
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
fetchAndReadSourcePackageRemoteTarball Verbosity
verbosity DistDirLayout
distDirLayout
Rebuild HttpTransport
getTransport URI
uri
| ProjectPackageRemoteTarball URI
uri <- [ProjectPackageLocation]
pkgLocations ]
[PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
pkgsRemoteRepo <-
Verbosity
-> DistDirLayout
-> ProjectConfigShared
-> [SourceRepoList]
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
syncAndReadSourcePackagesRemoteRepos
Verbosity
verbosity DistDirLayout
distDirLayout
ProjectConfigShared
projectConfigShared
[ SourceRepoList
repo | ProjectPackageRemoteRepo SourceRepoList
repo <- [ProjectPackageLocation]
pkgLocations ]
let pkgsNamed :: [PackageSpecifier pkg]
pkgsNamed =
[ forall pkg.
PackageName -> [PackageProperty] -> PackageSpecifier pkg
NamedPackage PackageName
pkgname [VersionRange -> PackageProperty
PackagePropertyVersion VersionRange
verrange]
| ProjectPackageNamed (PackageVersionConstraint PackageName
pkgname VersionRange
verrange) <- [ProjectPackageLocation]
pkgLocations ]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
pkgsLocalDirectory
, [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
pkgsLocalTarball
, [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
pkgsRemoteTarball
, [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
pkgsRemoteRepo
, forall {pkg}. [PackageSpecifier pkg]
pkgsNamed
]
where
projectPackageLocal :: ProjectPackageLocation -> [(String, String)]
projectPackageLocal (ProjectPackageLocalDirectory String
dir String
file) = [(String
dir, String
file)]
projectPackageLocal (ProjectPackageLocalCabalFile String
file) = [(String
dir, String
file)]
where dir :: String
dir = String -> String
takeDirectory String
file
projectPackageLocal ProjectPackageLocation
_ = []
progPathExtra :: [String]
progPathExtra = forall a. NubList a -> [a]
fromNubList (ProjectConfigShared -> NubList String
projectConfigProgPathExtra ProjectConfigShared
projectConfigShared)
preferredHttpTransport :: Maybe String
preferredHttpTransport =
forall a. Flag a -> Maybe a
flagToMaybe (ProjectConfigBuildOnly -> Flag String
projectConfigHttpTransport ProjectConfigBuildOnly
projectConfigBuildOnly)
readSourcePackageLocalDirectory
:: Verbosity
-> FilePath
-> FilePath
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
readSourcePackageLocalDirectory :: Verbosity
-> String
-> String
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
readSourcePackageLocalDirectory Verbosity
verbosity String
dir String
cabalFile = do
[MonitorFilePath] -> Rebuild ()
monitorFiles [String -> MonitorFilePath
monitorFileHashed String
cabalFile]
String
root <- Rebuild String
askRoot
let location :: PackageLocation local
location = forall local. String -> PackageLocation local
LocalUnpackedPackage (String
root String -> String -> String
</> String
dir)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PackageLocation String
-> GenericPackageDescription
-> PackageSpecifier (SourcePackage UnresolvedPkgLoc)
mkSpecificSourcePackage forall {local}. PackageLocation local
location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> String -> ByteString -> IO GenericPackageDescription
readSourcePackageCabalFile Verbosity
verbosity String
cabalFile
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ByteString
BS.readFile (String
root String -> String -> String
</> String
cabalFile)
readSourcePackageLocalTarball
:: Verbosity
-> FilePath
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
readSourcePackageLocalTarball :: Verbosity
-> String
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
readSourcePackageLocalTarball Verbosity
verbosity String
tarballFile = do
[MonitorFilePath] -> Rebuild ()
monitorFiles [String -> MonitorFilePath
monitorFile String
tarballFile]
String
root <- Rebuild String
askRoot
let location :: PackageLocation local
location = forall local. String -> PackageLocation local
LocalTarballPackage (String
root String -> String -> String
</> String
tarballFile)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PackageLocation String
-> GenericPackageDescription
-> PackageSpecifier (SourcePackage UnresolvedPkgLoc)
mkSpecificSourcePackage forall {local}. PackageLocation local
location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Verbosity -> String -> ByteString -> IO GenericPackageDescription
readSourcePackageCabalFile Verbosity
verbosity)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (String, ByteString)
extractTarballPackageCabalFile (String
root String -> String -> String
</> String
tarballFile)
fetchAndReadSourcePackageRemoteTarball
:: Verbosity
-> DistDirLayout
-> Rebuild HttpTransport
-> URI
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
fetchAndReadSourcePackageRemoteTarball :: Verbosity
-> DistDirLayout
-> Rebuild HttpTransport
-> URI
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
fetchAndReadSourcePackageRemoteTarball Verbosity
verbosity
DistDirLayout {
String
distDownloadSrcDirectory :: String
distDownloadSrcDirectory :: DistDirLayout -> String
distDownloadSrcDirectory
}
Rebuild HttpTransport
getTransport
URI
tarballUri =
forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b
rerunIfChanged Verbosity
verbosity FileMonitor URI (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
monitor URI
tarballUri forall a b. (a -> b) -> a -> b
$ do
HttpTransport
transport <- Rebuild HttpTransport
getTransport
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Verbosity -> HttpTransport -> URI -> IO ()
transportCheckHttps Verbosity
verbosity HttpTransport
transport URI
tarballUri
Verbosity -> String -> IO ()
notice Verbosity
verbosity (String
"Downloading " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show URI
tarballUri)
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True
String
distDownloadSrcDirectory
DownloadResult
_ <- HttpTransport -> Verbosity -> URI -> String -> IO DownloadResult
downloadURI HttpTransport
transport Verbosity
verbosity URI
tarballUri String
tarballFile
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[MonitorFilePath] -> Rebuild ()
monitorFiles [String -> MonitorFilePath
monitorFile String
tarballFile]
let location :: PackageLocation String
location = forall local. URI -> local -> PackageLocation local
RemoteTarballPackage URI
tarballUri String
tarballFile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PackageLocation String
-> GenericPackageDescription
-> PackageSpecifier (SourcePackage UnresolvedPkgLoc)
mkSpecificSourcePackage PackageLocation String
location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Verbosity -> String -> ByteString -> IO GenericPackageDescription
readSourcePackageCabalFile Verbosity
verbosity)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (String, ByteString)
extractTarballPackageCabalFile String
tarballFile
where
tarballStem :: FilePath
tarballStem :: String
tarballStem = String
distDownloadSrcDirectory
String -> String -> String
</> URI -> String
localFileNameForRemoteTarball URI
tarballUri
tarballFile :: FilePath
tarballFile :: String
tarballFile = String
tarballStem String -> String -> String
<.> String
"tar.gz"
monitor :: FileMonitor URI (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
monitor :: FileMonitor URI (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
monitor = forall a b. Eq a => String -> FileMonitor a b
newFileMonitor (String
tarballStem String -> String -> String
<.> String
"cache")
syncAndReadSourcePackagesRemoteRepos
:: Verbosity
-> DistDirLayout
-> ProjectConfigShared
-> [SourceRepoList]
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
syncAndReadSourcePackagesRemoteRepos :: Verbosity
-> DistDirLayout
-> ProjectConfigShared
-> [SourceRepoList]
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
syncAndReadSourcePackagesRemoteRepos Verbosity
verbosity
DistDirLayout{String
distDownloadSrcDirectory :: String
distDownloadSrcDirectory :: DistDirLayout -> String
distDownloadSrcDirectory}
ProjectConfigShared {
NubList String
projectConfigProgPathExtra :: NubList String
projectConfigProgPathExtra :: ProjectConfigShared -> NubList String
projectConfigProgPathExtra
}
[SourceRepoList]
repos = do
[(SourceRepoList, String, RepoType, VCS Program)]
repos' <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. [(SourceRepoList, SourceRepoProblem)] -> Rebuild a
reportSourceRepoProblems forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *).
[SourceRepositoryPackage f]
-> Either
[(SourceRepositoryPackage f, SourceRepoProblem)]
[(SourceRepositoryPackage f, String, RepoType, VCS Program)]
validateSourceRepos [SourceRepoList]
repos
let reposByLocation :: Map (RepoType, String)
[(SourceRepoList, RepoType)]
reposByLocation :: Map (RepoType, String) [(SourceRepoList, RepoType)]
reposByLocation = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++)
[ ((RepoType
rtype, String
rloc), [(SourceRepoList
repo, forall program. VCS program -> RepoType
vcsRepoType VCS Program
vcs)])
| (SourceRepoList
repo, String
rloc, RepoType
rtype, VCS Program
vcs) <- [(SourceRepoList, String, RepoType, VCS Program)]
repos' ]
let _progPathExtra :: [String]
_progPathExtra = forall a. NubList a -> [a]
fromNubList NubList String
projectConfigProgPathExtra
RepoType -> Rebuild (VCS ConfiguredProgram)
getConfiguredVCS <- forall k v. Ord k => (k -> IO v) -> Rebuild (k -> Rebuild v)
delayInitSharedResources forall a b. (a -> b) -> a -> b
$ \RepoType
repoType ->
let vcs :: VCS Program
vcs = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unknown VCS: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow RepoType
repoType) RepoType
repoType Map RepoType (VCS Program)
knownVCSs in
Verbosity -> VCS Program -> IO (VCS ConfiguredProgram)
configureVCS Verbosity
verbosity VCS Program
vcs
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
[ forall a b.
(Binary a, Structured a, Binary b, Structured b) =>
Verbosity -> FileMonitor a b -> a -> Rebuild b -> Rebuild b
rerunIfChanged Verbosity
verbosity FileMonitor
[SourceRepoList]
[PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
monitor [SourceRepoList]
repoGroup' forall a b. (a -> b) -> a -> b
$ do
VCS ConfiguredProgram
vcs' <- RepoType -> Rebuild (VCS ConfiguredProgram)
getConfiguredVCS RepoType
repoType
VCS ConfiguredProgram
-> String
-> [SourceRepoList]
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
syncRepoGroupAndReadSourcePackages VCS ConfiguredProgram
vcs' String
pathStem [SourceRepoList]
repoGroup'
| repoGroup :: [(SourceRepoList, RepoType)]
repoGroup@((SourceRepoList
primaryRepo, RepoType
repoType):[(SourceRepoList, RepoType)]
_) <- forall k a. Map k a -> [a]
Map.elems Map (RepoType, String) [(SourceRepoList, RepoType)]
reposByLocation
, let repoGroup' :: [SourceRepoList]
repoGroup' = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(SourceRepoList, RepoType)]
repoGroup
pathStem :: String
pathStem = String
distDownloadSrcDirectory
String -> String -> String
</> SourceRepoList -> String
localFileNameForRemoteRepo SourceRepoList
primaryRepo
monitor :: FileMonitor
[SourceRepoList]
[PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
monitor :: FileMonitor
[SourceRepoList]
[PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
monitor = forall a b. Eq a => String -> FileMonitor a b
newFileMonitor (String
pathStem String -> String -> String
<.> String
"cache")
]
where
syncRepoGroupAndReadSourcePackages
:: VCS ConfiguredProgram
-> FilePath
-> [SourceRepoList]
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
syncRepoGroupAndReadSourcePackages :: VCS ConfiguredProgram
-> String
-> [SourceRepoList]
-> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
syncRepoGroupAndReadSourcePackages VCS ConfiguredProgram
vcs String
pathStem [SourceRepoList]
repoGroup = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
False
String
distDownloadSrcDirectory
forall (f :: * -> *).
Verbosity
-> VCS ConfiguredProgram
-> [(SourceRepositoryPackage f, String)]
-> Rebuild ()
syncSourceRepos Verbosity
verbosity VCS ConfiguredProgram
vcs
[ (SourceRepositoryPackage Proxy
repo, String
repoPath)
| (SourceRepositoryPackage Proxy
repo, NonEmpty (SourceRepositoryPackage Maybe)
_, String
repoPath) <- [(SourceRepositoryPackage Proxy,
NonEmpty (SourceRepositoryPackage Maybe), String)]
repoGroupWithPaths ]
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(SourceRepositoryPackage Proxy,
NonEmpty (SourceRepositoryPackage Maybe), String)]
repoGroupWithPaths forall a b. (a -> b) -> a -> b
$ \(SourceRepositoryPackage Proxy
repo, NonEmpty (SourceRepositoryPackage Maybe)
_, String
repoPath) ->
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (forall (f :: * -> *). SourceRepositoryPackage f -> [String]
srpCommand SourceRepositoryPackage Proxy
repo)) forall a b. (a -> b) -> a -> b
$ \(String
cmd :| [String]
args) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
IO ExitCode -> IO ()
maybeExit forall a b. (a -> b) -> a -> b
$ Verbosity
-> String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ExitCode
rawSystemIOWithEnv Verbosity
verbosity String
cmd [String]
args (forall a. a -> Maybe a
Just String
repoPath) forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
[ SourceRepositoryPackage Maybe
-> String
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
readPackageFromSourceRepo SourceRepositoryPackage Maybe
repoWithSubdir String
repoPath
| (SourceRepositoryPackage Proxy
_, NonEmpty (SourceRepositoryPackage Maybe)
reposWithSubdir, String
repoPath) <- [(SourceRepositoryPackage Proxy,
NonEmpty (SourceRepositoryPackage Maybe), String)]
repoGroupWithPaths
, SourceRepositoryPackage Maybe
repoWithSubdir <- forall a. NonEmpty a -> [a]
NE.toList NonEmpty (SourceRepositoryPackage Maybe)
reposWithSubdir ]
where
repoGroupWithPaths
:: [(SourceRepositoryPackage Proxy, NonEmpty (SourceRepositoryPackage Maybe), FilePath)]
repoGroupWithPaths :: [(SourceRepositoryPackage Proxy,
NonEmpty (SourceRepositoryPackage Maybe), String)]
repoGroupWithPaths =
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(SourceRepositoryPackage Proxy
x, NonEmpty (SourceRepositoryPackage Maybe)
y) String
z -> (SourceRepositoryPackage Proxy
x,NonEmpty (SourceRepositoryPackage Maybe)
y,String
z))
(forall k v. Ord k => [(k, v)] -> [(k, NonEmpty v)]
mapGroup
[ (SourceRepositoryPackage Maybe
repo { srpSubdir :: Proxy String
srpSubdir = forall {k} (t :: k). Proxy t
Proxy }, SourceRepositoryPackage Maybe
repo)
| SourceRepositoryPackage Maybe
repo <- forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. NonEmpty a -> [a]
NE.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceRepoList -> NonEmpty (SourceRepositoryPackage Maybe)
srpFanOut) [SourceRepoList]
repoGroup
])
[String]
repoPaths
mapGroup :: Ord k => [(k, v)] -> [(k, NonEmpty v)]
mapGroup :: forall k v. Ord k => [(k, v)] -> [(k, NonEmpty v)]
mapGroup = forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(k
k, v
v) -> (k
k, forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v))
repoPaths :: [FilePath]
repoPaths :: [String]
repoPaths = String
pathStem
forall a. a -> [a] -> [a]
: [ String
pathStem forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
i :: Int) | Int
i <- [Int
2..] ]
readPackageFromSourceRepo
:: SourceRepositoryPackage Maybe
-> FilePath
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
readPackageFromSourceRepo :: SourceRepositoryPackage Maybe
-> String
-> Rebuild (PackageSpecifier (SourcePackage UnresolvedPkgLoc))
readPackageFromSourceRepo SourceRepositoryPackage Maybe
repo String
repoPath = do
let packageDir :: FilePath
packageDir :: String
packageDir = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
repoPath (String
repoPath String -> String -> String
</>) (forall (f :: * -> *). SourceRepositoryPackage f -> f String
srpSubdir SourceRepositoryPackage Maybe
repo)
[String]
entries <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
packageDir
case forall a. (a -> Bool) -> [a] -> [a]
filter (\String
e -> String -> String
takeExtension String
e forall a. Eq a => a -> a -> Bool
== String
".cabal") [String]
entries of
[] -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> CabalFileSearchFailure
NoCabalFileFound String
packageDir
(String
_:String
_:[String]
_) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> CabalFileSearchFailure
MultipleCabalFilesFound String
packageDir
[String
cabalFileName] -> do
let cabalFilePath :: String
cabalFilePath = String
packageDir String -> String -> String
</> String
cabalFileName
[MonitorFilePath] -> Rebuild ()
monitorFiles [String -> MonitorFilePath
monitorFileHashed String
cabalFilePath]
GenericPackageDescription
gpd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> ByteString -> IO GenericPackageDescription
readSourcePackageCabalFile Verbosity
verbosity String
cabalFilePath forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ByteString
BS.readFile String
cabalFilePath
ByteString
tarball <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> GenericPackageDescription -> String -> IO ByteString
packageDirToSdist Verbosity
verbosity GenericPackageDescription
gpd String
packageDir
let tarballPath :: String
tarballPath = String
repoPath forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (forall pkg. Package pkg => pkg -> PackageId
packageId GenericPackageDescription
gpd) forall a. [a] -> [a] -> [a]
++ String
".tar.gz"
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
tarballPath ByteString
tarball
let location :: PackageLocation String
location = forall local.
SourceRepositoryPackage Maybe -> local -> PackageLocation local
RemoteSourceRepoPackage SourceRepositoryPackage Maybe
repo String
tarballPath
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PackageLocation String
-> GenericPackageDescription
-> PackageSpecifier (SourcePackage UnresolvedPkgLoc)
mkSpecificSourcePackage PackageLocation String
location GenericPackageDescription
gpd
reportSourceRepoProblems :: [(SourceRepoList, SourceRepoProblem)] -> Rebuild a
reportSourceRepoProblems :: forall a. [(SourceRepoList, SourceRepoProblem)] -> Rebuild a
reportSourceRepoProblems = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SourceRepoList, SourceRepoProblem)] -> String
renderSourceRepoProblems
renderSourceRepoProblems :: [(SourceRepoList, SourceRepoProblem)] -> String
renderSourceRepoProblems :: [(SourceRepoList, SourceRepoProblem)] -> String
renderSourceRepoProblems = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show
mkSpecificSourcePackage :: PackageLocation FilePath
-> GenericPackageDescription
-> PackageSpecifier (SourcePackage UnresolvedPkgLoc)
mkSpecificSourcePackage :: PackageLocation String
-> GenericPackageDescription
-> PackageSpecifier (SourcePackage UnresolvedPkgLoc)
mkSpecificSourcePackage PackageLocation String
location GenericPackageDescription
pkg =
forall pkg. pkg -> PackageSpecifier pkg
SpecificSourcePackage SourcePackage
{ srcpkgPackageId :: PackageId
srcpkgPackageId = forall pkg. Package pkg => pkg -> PackageId
packageId GenericPackageDescription
pkg
, srcpkgDescription :: GenericPackageDescription
srcpkgDescription = GenericPackageDescription
pkg
, srcpkgSource :: UnresolvedPkgLoc
srcpkgSource = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just PackageLocation String
location
, srcpkgDescrOverride :: PackageDescriptionOverride
srcpkgDescrOverride = forall a. Maybe a
Nothing
}
data CabalFileParseError = CabalFileParseError
FilePath
BS.ByteString
(NonEmpty PError)
(Maybe Version)
[PWarning]
deriving (Typeable)
instance Show CabalFileParseError where
showsPrec :: Int -> CabalFileParseError -> String -> String
showsPrec Int
d (CabalFileParseError String
fp ByteString
_ NonEmpty PError
es Maybe Version
mv [PWarning]
ws) = Bool -> (String -> String) -> String -> String
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
forall a b. (a -> b) -> a -> b
$ String -> String -> String
showString String
"CabalFileParseError"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 String
fp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 (String
"" :: String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 NonEmpty PError
es
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 Maybe Version
mv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 [PWarning]
ws
instance Exception CabalFileParseError
#if MIN_VERSION_base(4,8,0)
where
displayException :: CabalFileParseError -> String
displayException = CabalFileParseError -> String
renderCabalFileParseError
#endif
renderCabalFileParseError :: CabalFileParseError -> String
renderCabalFileParseError :: CabalFileParseError -> String
renderCabalFileParseError (CabalFileParseError String
filePath ByteString
contents NonEmpty PError
errors Maybe Version
_ [PWarning]
warnings) =
String -> ByteString -> NonEmpty PError -> [PWarning] -> String
renderParseError String
filePath ByteString
contents NonEmpty PError
errors [PWarning]
warnings
readSourcePackageCabalFile :: Verbosity
-> FilePath
-> BS.ByteString
-> IO GenericPackageDescription
readSourcePackageCabalFile :: Verbosity -> String -> ByteString -> IO GenericPackageDescription
readSourcePackageCabalFile Verbosity
verbosity String
pkgfilename ByteString
content =
case forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult (ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription ByteString
content) of
([PWarning]
warnings, Right GenericPackageDescription
pkg) -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PWarning]
warnings) forall a b. (a -> b) -> a -> b
$
Verbosity -> String -> IO ()
info Verbosity
verbosity ([PWarning] -> String
formatWarnings [PWarning]
warnings)
forall (m :: * -> *) a. Monad m => a -> m a
return GenericPackageDescription
pkg
([PWarning]
warnings, Left (Maybe Version
mspecVersion, NonEmpty PError
errors)) ->
forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String
-> ByteString
-> NonEmpty PError
-> Maybe Version
-> [PWarning]
-> CabalFileParseError
CabalFileParseError String
pkgfilename ByteString
content NonEmpty PError
errors Maybe Version
mspecVersion [PWarning]
warnings
where
formatWarnings :: [PWarning] -> String
formatWarnings [PWarning]
warnings =
String
"The package description file " forall a. [a] -> [a] -> [a]
++ String
pkgfilename
forall a. [a] -> [a] -> [a]
++ String
" has warnings: "
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (String -> PWarning -> String
showPWarning String
pkgfilename) [PWarning]
warnings)
data CabalFileSearchFailure
= NoCabalFileFound FilePath
| MultipleCabalFilesFound FilePath
deriving (Int -> CabalFileSearchFailure -> String -> String
[CabalFileSearchFailure] -> String -> String
CabalFileSearchFailure -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CabalFileSearchFailure] -> String -> String
$cshowList :: [CabalFileSearchFailure] -> String -> String
show :: CabalFileSearchFailure -> String
$cshow :: CabalFileSearchFailure -> String
showsPrec :: Int -> CabalFileSearchFailure -> String -> String
$cshowsPrec :: Int -> CabalFileSearchFailure -> String -> String
Show, Typeable)
instance Exception CabalFileSearchFailure
extractTarballPackageCabalFile :: FilePath -> IO (FilePath, BS.ByteString)
String
tarballFile =
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
tarballFile IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
hnd -> do
ByteString
content <- Handle -> IO ByteString
LBS.hGetContents Handle
hnd
case String
-> ByteString
-> Either
(Either FormatError CabalFileSearchFailure) (String, ByteString)
extractTarballPackageCabalFilePure String
tarballFile ByteString
content of
Left (Left FormatError
e) -> forall e a. Exception e => e -> IO a
throwIO FormatError
e
Left (Right CabalFileSearchFailure
e) -> forall e a. Exception e => e -> IO a
throwIO CabalFileSearchFailure
e
Right (String
fileName, ByteString
fileContent) ->
(,) String
fileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO a
evaluate (ByteString -> ByteString
LBS.toStrict ByteString
fileContent)
extractTarballPackageCabalFilePure :: FilePath
-> LBS.ByteString
-> Either (Either Tar.FormatError
CabalFileSearchFailure)
(FilePath, LBS.ByteString)
String
tarballFile =
forall {a} {b} {k}.
Either (a, b) (Map k Entry)
-> Either (Either a CabalFileSearchFailure) (String, ByteString)
check
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {e}.
Entries e -> Either (e, Map TarPath Entry) (Map TarPath Entry)
accumEntryMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. (Entry -> Bool) -> Entries e -> Entries e
Tar.filterEntries Entry -> Bool
isCabalFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Entries FormatError
Tar.read
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZipUtils.maybeDecompress
where
accumEntryMap :: Entries e -> Either (e, Map TarPath Entry) (Map TarPath Entry)
accumEntryMap = forall a e. (a -> Entry -> a) -> a -> Entries e -> Either (e, a) a
Tar.foldlEntries
(\Map TarPath Entry
m Entry
e -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Entry -> TarPath
Tar.entryTarPath Entry
e) Entry
e Map TarPath Entry
m)
forall k a. Map k a
Map.empty
check :: Either (a, b) (Map k Entry)
-> Either (Either a CabalFileSearchFailure) (String, ByteString)
check (Left (a
e, b
_m)) = forall a b. a -> Either a b
Left (forall a b. a -> Either a b
Left a
e)
check (Right Map k Entry
m) = case forall k a. Map k a -> [a]
Map.elems Map k Entry
m of
[] -> forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> CabalFileSearchFailure
NoCabalFileFound String
tarballFile)
[Entry
file] -> case Entry -> EntryContent
Tar.entryContent Entry
file of
Tar.NormalFile ByteString
content FileSize
_ -> forall a b. b -> Either a b
Right (Entry -> String
Tar.entryPath Entry
file, ByteString
content)
EntryContent
_ -> forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> CabalFileSearchFailure
NoCabalFileFound String
tarballFile)
[Entry]
_files -> forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> CabalFileSearchFailure
MultipleCabalFilesFound String
tarballFile)
isCabalFile :: Entry -> Bool
isCabalFile Entry
e = case String -> [String]
splitPath (Entry -> String
Tar.entryPath Entry
e) of
[ String
_dir, String
file] -> String -> String
takeExtension String
file forall a. Eq a => a -> a -> Bool
== String
".cabal"
[String
".", String
_dir, String
file] -> String -> String
takeExtension String
file forall a. Eq a => a -> a -> Bool
== String
".cabal"
[String]
_ -> Bool
False
localFileNameForRemoteTarball :: URI -> FilePath
localFileNameForRemoteTarball :: URI -> String
localFileNameForRemoteTarball URI
uri =
URI -> String
mangleName URI
uri
forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. (Integral a, Show a) => a -> String -> String
showHex Word
locationHash String
""
where
mangleName :: URI -> String
mangleName = Int -> String -> String
truncateString Int
10 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropExtension forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropExtension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeFileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropTrailingPathSeparator forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
uriPath
locationHash :: Word
locationHash :: Word
locationHash = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Hashable a => a -> Int
Hashable.hash ((String -> String) -> URI -> String -> String
uriToString forall a. a -> a
id URI
uri String
""))
localFileNameForRemoteRepo :: SourceRepoList -> FilePath
localFileNameForRemoteRepo :: SourceRepoList -> String
localFileNameForRemoteRepo SourceRepositoryPackage {RepoType
srpType :: forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
srpType :: RepoType
srpType, String
srpLocation :: forall (f :: * -> *). SourceRepositoryPackage f -> String
srpLocation :: String
srpLocation} =
String -> String
mangleName String
srpLocation forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. (Integral a, Show a) => a -> String -> String
showHex Word
locationHash String
""
where
mangleName :: String -> String
mangleName = Int -> String -> String
truncateString Int
10 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropExtension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeFileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropTrailingPathSeparator
locationHash :: Word
locationHash :: Word
locationHash =
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Hashable a => a -> Int
Hashable.hash (forall a. Show a => a -> String
show RepoType
srpType, String
srpLocation))
truncateString :: Int -> String -> String
truncateString :: Int -> String -> String
truncateString Int
n String
s | forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s forall a. Ord a => a -> a -> Bool
<= Int
n = String
s
| Bool
otherwise = forall a. Int -> [a] -> [a]
take (Int
nforall a. Num a => a -> a -> a
-Int
1) String
s forall a. [a] -> [a] -> [a]
++ String
"_"
data BadPerPackageCompilerPaths
= BadPerPackageCompilerPaths [(PackageName, String)]
#if MIN_VERSION_base(4,8,0)
deriving (Int -> BadPerPackageCompilerPaths -> String -> String
[BadPerPackageCompilerPaths] -> String -> String
BadPerPackageCompilerPaths -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [BadPerPackageCompilerPaths] -> String -> String
$cshowList :: [BadPerPackageCompilerPaths] -> String -> String
show :: BadPerPackageCompilerPaths -> String
$cshow :: BadPerPackageCompilerPaths -> String
showsPrec :: Int -> BadPerPackageCompilerPaths -> String -> String
$cshowsPrec :: Int -> BadPerPackageCompilerPaths -> String -> String
Show, Typeable)
#else
deriving (Typeable)
instance Show BadPerPackageCompilerPaths where
show = renderBadPerPackageCompilerPaths
#endif
instance Exception BadPerPackageCompilerPaths where
#if MIN_VERSION_base(4,8,0)
displayException :: BadPerPackageCompilerPaths -> String
displayException = BadPerPackageCompilerPaths -> String
renderBadPerPackageCompilerPaths
#endif
renderBadPerPackageCompilerPaths :: BadPerPackageCompilerPaths -> String
renderBadPerPackageCompilerPaths :: BadPerPackageCompilerPaths -> String
renderBadPerPackageCompilerPaths
(BadPerPackageCompilerPaths ((PackageName
pkgname, String
progname) : [(PackageName, String)]
_)) =
String
"The path to the compiler program (or programs used by the compiler) "
forall a. [a] -> [a] -> [a]
++ String
"cannot be specified on a per-package basis in the cabal.project file "
forall a. [a] -> [a] -> [a]
++ String
"(i.e. setting the '" forall a. [a] -> [a] -> [a]
++ String
progname forall a. [a] -> [a] -> [a]
++ String
"-location' for package '"
forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow PackageName
pkgname forall a. [a] -> [a] -> [a]
++ String
"'). All packages have to use the same compiler, so "
forall a. [a] -> [a] -> [a]
++ String
"specify the path in a global 'program-locations' section."
renderBadPerPackageCompilerPaths BadPerPackageCompilerPaths
_ = forall a. HasCallStack => String -> a
error String
"renderBadPerPackageCompilerPaths"
checkBadPerPackageCompilerPaths :: [ConfiguredProgram]
-> Map PackageName PackageConfig
-> IO ()
checkBadPerPackageCompilerPaths :: [ConfiguredProgram] -> Map PackageName PackageConfig -> IO ()
checkBadPerPackageCompilerPaths [ConfiguredProgram]
compilerPrograms Map PackageName PackageConfig
packagesConfig =
case [ (PackageName
pkgname, String
progname)
| let compProgNames :: Set String
compProgNames = forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map ConfiguredProgram -> String
programId [ConfiguredProgram]
compilerPrograms)
, (PackageName
pkgname, PackageConfig
pkgconf) <- forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName PackageConfig
packagesConfig
, String
progname <- forall k a. Map k a -> [k]
Map.keys (forall k v. MapLast k v -> Map k v
getMapLast (PackageConfig -> MapLast String String
packageConfigProgramPaths PackageConfig
pkgconf))
, String
progname forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
compProgNames ] of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
[(PackageName, String)]
ps -> forall e a. Exception e => e -> IO a
throwIO ([(PackageName, String)] -> BadPerPackageCompilerPaths
BadPerPackageCompilerPaths [(PackageName, String)]
ps)