From 108f6c1ef47f2605f07afa1fb5906ef0049e07d9 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 21 Mar 2020 21:19:35 +0200 Subject: [PATCH] Split D.Client.Types module --- cabal-install/Distribution/Client/Config.hs | 3 +- cabal-install/Distribution/Client/Get.hs | 2 +- .../Client/IndexUtils/IndexState.hs | 4 +- .../Distribution/Client/ProjectConfig.hs | 2 +- .../Client/ProjectConfig/Legacy.hs | 8 +- .../Client/ProjectConfig/Types.hs | 8 +- .../Distribution/Client/ProjectPlanOutput.hs | 6 +- cabal-install/Distribution/Client/Setup.hs | 11 +- cabal-install/Distribution/Client/Types.hs | 718 +----------------- .../Distribution/Client/Types/AllowNewer.hs | 191 +++++ .../Distribution/Client/Types/BuildResults.hs | 61 ++ .../Distribution/Client/Types/ConfiguredId.hs | 83 ++ .../Client/Types/ConfiguredPackage.hs | 86 +++ .../Distribution/Client/Types/Credentials.hs | 7 + .../Client/Types/PackageLocation.hs | 50 ++ .../Client/Types/PackageSpecifier.hs | 55 ++ .../Distribution/Client/Types/Packages.hs | 0 .../Distribution/Client/Types/ReadyPackage.hs | 31 + .../Distribution/Client/Types/Repo.hs | 193 +++++ .../Distribution/Client/Types/RepoName.hs | 39 + .../Client/Types/SourcePackageDb.hs | 23 + .../Client/{ => Types}/SourceRepo.hs | 11 +- .../Types/WriteGhcEnvironmentFilesPolicy.hs | 20 + cabal-install/Distribution/Client/Upload.hs | 5 +- cabal-install/Distribution/Client/VCS.hs | 2 +- cabal-install/cabal-install.cabal | 14 +- cabal-install/cabal-install.cabal.pp | 14 +- cabal-install/main/Main.hs | 2 +- .../UnitTests/Distribution/Client/Get.hs | 2 +- .../Distribution/Client/ProjectConfig.hs | 2 +- .../Distribution/Client/TreeDiffInstances.hs | 2 +- .../UnitTests/Distribution/Client/VCS.hs | 2 +- 32 files changed, 933 insertions(+), 724 deletions(-) create mode 100644 cabal-install/Distribution/Client/Types/AllowNewer.hs create mode 100644 cabal-install/Distribution/Client/Types/BuildResults.hs create mode 100644 cabal-install/Distribution/Client/Types/ConfiguredId.hs create mode 100644 cabal-install/Distribution/Client/Types/ConfiguredPackage.hs create mode 100644 cabal-install/Distribution/Client/Types/Credentials.hs create mode 100644 cabal-install/Distribution/Client/Types/PackageLocation.hs create mode 100644 cabal-install/Distribution/Client/Types/PackageSpecifier.hs create mode 100644 cabal-install/Distribution/Client/Types/Packages.hs create mode 100644 cabal-install/Distribution/Client/Types/ReadyPackage.hs create mode 100644 cabal-install/Distribution/Client/Types/Repo.hs create mode 100644 cabal-install/Distribution/Client/Types/RepoName.hs create mode 100644 cabal-install/Distribution/Client/Types/SourcePackageDb.hs rename cabal-install/Distribution/Client/{ => Types}/SourceRepo.hs (95%) create mode 100644 cabal-install/Distribution/Client/Types/WriteGhcEnvironmentFilesPolicy.hs diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index f57b1f97ab1..d0a6f099213 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/cabal-install/Distribution/Client/Config.hs @@ -51,10 +51,11 @@ import Distribution.Deprecated.ViewAsFieldDescr ( viewAsFieldDescr ) import Distribution.Client.Types - ( RemoteRepo(..), LocalRepo (..), Username(..), Password(..), emptyRemoteRepo + ( RemoteRepo(..), LocalRepo (..), emptyRemoteRepo , AllowOlder(..), AllowNewer(..), RelaxDeps(..), isRelaxDeps , RepoName (..), unRepoName ) +import Distribution.Client.Types.Credentials (Username (..), Password (..)) import Distribution.Client.BuildReports.Types ( ReportLevel(..) ) import qualified Distribution.Client.Init.Types as IT diff --git a/cabal-install/Distribution/Client/Get.hs b/cabal-install/Distribution/Client/Get.hs index 41e1443722a..925897f4b63 100644 --- a/cabal-install/Distribution/Client/Get.hs +++ b/cabal-install/Distribution/Client/Get.hs @@ -41,7 +41,7 @@ import qualified Distribution.PackageDescription as PD import Distribution.Simple.Program ( programName ) import Distribution.Types.SourceRepo (RepoKind (..)) -import Distribution.Client.SourceRepo (SourceRepositoryPackage (..), SourceRepoProxy, srpToProxy) +import Distribution.Client.Types.SourceRepo (SourceRepositoryPackage (..), SourceRepoProxy, srpToProxy) import Distribution.Client.Setup ( GlobalFlags(..), GetFlags(..), RepoContext(..) ) diff --git a/cabal-install/Distribution/Client/IndexUtils/IndexState.hs b/cabal-install/Distribution/Client/IndexUtils/IndexState.hs index 15178e88990..2c30c3a6655 100644 --- a/cabal-install/Distribution/Client/IndexUtils/IndexState.hs +++ b/cabal-install/Distribution/Client/IndexUtils/IndexState.hs @@ -19,14 +19,14 @@ module Distribution.Client.IndexUtils.IndexState ( import Distribution.Client.Compat.Prelude import Distribution.Client.IndexUtils.Timestamp (Timestamp) -import Distribution.Client.Types (RepoName (..)) +import Distribution.Client.Types.RepoName (RepoName (..)) import Distribution.FieldGrammar.Described import Distribution.Parsec (Parsec (..)) import Distribution.Pretty (Pretty (..)) +import qualified Data.Map.Strict as Map import qualified Distribution.Compat.CharParsing as P -import qualified Data.Map.Strict as Map import qualified Text.PrettyPrint as Disp ------------------------------------------------------------------------------- diff --git a/cabal-install/Distribution/Client/ProjectConfig.hs b/cabal-install/Distribution/Client/ProjectConfig.hs index 234c5f13395..45d1a0aa6d2 100644 --- a/cabal-install/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/Distribution/Client/ProjectConfig.hs @@ -103,7 +103,7 @@ import Distribution.Fields import Distribution.Pretty (prettyShow) import Distribution.Types.SourceRepo ( RepoType(..) ) -import Distribution.Client.SourceRepo +import Distribution.Client.Types.SourceRepo ( SourceRepoList, SourceRepositoryPackage (..), srpFanOut ) import Distribution.Simple.Compiler ( Compiler, compilerInfo ) diff --git a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs index fc679ca593e..834e2400e16 100644 --- a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs @@ -26,10 +26,10 @@ import Distribution.Client.Compat.Prelude import Distribution.Deprecated.ParseUtils (parseFlagAssignment) import Distribution.Client.ProjectConfig.Types -import Distribution.Client.Types - ( RepoName (..), RemoteRepo(..), LocalRepo (..), emptyRemoteRepo - , AllowNewer(..), AllowOlder(..), unRepoName ) -import Distribution.Client.SourceRepo (sourceRepositoryPackageGrammar, SourceRepoList) +import Distribution.Client.Types.RepoName (RepoName (..), unRepoName) +import Distribution.Client.Types.Repo (RemoteRepo(..), LocalRepo (..), emptyRemoteRepo) +import Distribution.Client.Types.AllowNewer (AllowNewer(..), AllowOlder(..)) +import Distribution.Client.Types.SourceRepo (sourceRepositoryPackageGrammar, SourceRepoList) import Distribution.Client.Config ( SavedConfig(..), remoteRepoFields, postProcessRepo ) diff --git a/cabal-install/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/Distribution/Client/ProjectConfig/Types.hs index dd3854b19ed..e92cf632b67 100644 --- a/cabal-install/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal-install/Distribution/Client/ProjectConfig/Types.hs @@ -23,16 +23,16 @@ module Distribution.Client.ProjectConfig.Types ( import Distribution.Client.Compat.Prelude import Prelude () -import Distribution.Client.Types - ( RemoteRepo, LocalRepo, AllowNewer(..), AllowOlder(..) - , WriteGhcEnvironmentFilesPolicy ) +import Distribution.Client.Types.Repo ( RemoteRepo, LocalRepo ) +import Distribution.Client.Types.AllowNewer ( AllowNewer(..), AllowOlder(..) ) +import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy ( WriteGhcEnvironmentFilesPolicy ) import Distribution.Client.Dependency.Types ( PreSolver ) import Distribution.Client.Targets ( UserConstraint ) import Distribution.Client.BuildReports.Types ( ReportLevel(..) ) -import Distribution.Client.SourceRepo (SourceRepoList) +import Distribution.Client.Types.SourceRepo (SourceRepoList) import Distribution.Client.IndexUtils.IndexState ( TotalIndexState ) diff --git a/cabal-install/Distribution/Client/ProjectPlanOutput.hs b/cabal-install/Distribution/Client/ProjectPlanOutput.hs index eab89cbd7f5..38311b25e5c 100644 --- a/cabal-install/Distribution/Client/ProjectPlanOutput.hs +++ b/cabal-install/Distribution/Client/ProjectPlanOutput.hs @@ -18,9 +18,11 @@ module Distribution.Client.ProjectPlanOutput ( import Distribution.Client.ProjectPlanning.Types import Distribution.Client.ProjectBuilding.Types import Distribution.Client.DistDirLayout -import Distribution.Client.Types (Repo(..), RemoteRepo(..), PackageLocation(..), confInstId) +import Distribution.Client.Types.Repo (Repo(..), RemoteRepo(..)) +import Distribution.Client.Types.PackageLocation (PackageLocation(..)) +import Distribution.Client.Types.ConfiguredId (confInstId) +import Distribution.Client.Types.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..)) import Distribution.Client.HashValue (showHashValue, hashValue) -import Distribution.Client.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..)) import qualified Distribution.Client.InstallPlan as InstallPlan import qualified Distribution.Client.Utils.Json as J diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 0fd24304e2d..8b6cb21e725 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -67,12 +67,11 @@ import Distribution.Client.Compat.Prelude hiding (get) import Distribution.Deprecated.ReadP (readP_to_E) -import Distribution.Client.Types - ( Username(..), Password(..), RemoteRepo(..) - , LocalRepo (..) - , AllowNewer(..), AllowOlder(..), RelaxDeps(..) - , WriteGhcEnvironmentFilesPolicy(..) - ) +import Distribution.Client.Types.Credentials (Username (..), Password (..)) +import Distribution.Client.Types.Repo (RemoteRepo(..), LocalRepo (..)) +import Distribution.Client.Types.AllowNewer (AllowNewer(..), AllowOlder(..), RelaxDeps(..)) +import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy + import Distribution.Client.BuildReports.Types ( ReportLevel(..) ) import Distribution.Client.Dependency.Types diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs index 96edc369a4e..fe5710d9477 100644 --- a/cabal-install/Distribution/Client/Types.hs +++ b/cabal-install/Distribution/Client/Types.hs @@ -17,695 +17,29 @@ -- -- Various common data types for the entire cabal-install system ----------------------------------------------------------------------------- -module Distribution.Client.Types where - -import Prelude () -import Distribution.Client.Compat.Prelude - -import Distribution.Package - ( Package(..), HasMungedPackageId(..), HasUnitId(..) - , PackageIdentifier(..), packageVersion, packageName - , PackageInstalled(..), newSimpleUnitId ) -import Distribution.InstalledPackageInfo - ( InstalledPackageInfo, installedComponentId, sourceComponentName ) -import Distribution.PackageDescription - ( FlagAssignment ) -import Distribution.Version - ( VersionRange, nullVersion, thisVersion ) -import Distribution.Types.ComponentId - ( ComponentId ) -import Distribution.Types.MungedPackageId - ( computeCompatPackageId ) -import Distribution.Types.PackageId - ( PackageId ) -import Distribution.Types.AnnotatedId -import Distribution.Types.UnitId - ( UnitId ) -import Distribution.Types.PackageName - ( PackageName, mkPackageName ) -import Distribution.Types.ComponentName - ( ComponentName(..) ) -import Distribution.Types.LibraryName - ( LibraryName(..) ) -import Distribution.Client.SourceRepo - ( SourceRepoMaybe ) -import Distribution.Client.HashValue (showHashValue, hashValue, truncateHash) - -import Distribution.Solver.Types.PackageIndex - ( PackageIndex ) -import qualified Distribution.Solver.Types.ComponentDeps as CD -import Distribution.Solver.Types.ComponentDeps - ( ComponentDeps ) -import Distribution.Solver.Types.ConstraintSource -import Distribution.Solver.Types.LabeledPackageConstraint -import Distribution.Solver.Types.OptionalStanza -import Distribution.Solver.Types.PackageConstraint -import Distribution.Solver.Types.PackageFixedDeps -import Distribution.Solver.Types.SourcePackage -import Distribution.Compat.Graph (IsNode(..)) -import qualified Distribution.Deprecated.ReadP as Parse -import Distribution.Deprecated.ParseUtils (parseOptCommaList) -import Distribution.Simple.Utils (ordNub, toUTF8BS) -import Distribution.Deprecated.Text (Text(..)) - -import Network.URI (URI(..), nullURI, uriToString, parseAbsoluteURI) -import Control.Exception (Exception, SomeException) - -import qualified Text.PrettyPrint as Disp -import qualified Distribution.Compat.CharParsing as P -import qualified Data.ByteString.Lazy.Char8 as LBS - -import Distribution.Pretty (Pretty (..)) -import Distribution.Parsec (Parsec (..)) -import Distribution.FieldGrammar.Described (Described (..), reMunch1CS, csAlphaNum) - - -newtype Username = Username { unUsername :: String } -newtype Password = Password { unPassword :: String } - --- | This is the information we get from a @00-index.tar.gz@ hackage index. --- -data SourcePackageDb = SourcePackageDb { - packageIndex :: PackageIndex UnresolvedSourcePackage, - packagePreferences :: Map PackageName VersionRange -} - deriving (Eq, Generic) - -instance Binary SourcePackageDb - --- ------------------------------------------------------------ --- * Various kinds of information about packages --- ------------------------------------------------------------ - --- | Within Cabal the library we no longer have a @InstalledPackageId@ type. --- That's because it deals with the compilers' notion of a registered library, --- and those really are libraries not packages. Those are now named units. --- --- The package management layer does however deal with installed packages, as --- whole packages not just as libraries. So we do still need a type for --- installed package ids. At the moment however we track instaled packages via --- their primary library, which is a unit id. In future this may change --- slightly and we may distinguish these two types and have an explicit --- conversion when we register units with the compiler. --- -type InstalledPackageId = ComponentId - - --- | A 'ConfiguredPackage' is a not-yet-installed package along with the --- total configuration information. The configuration information is total in --- the sense that it provides all the configuration information and so the --- final configure process will be independent of the environment. --- --- 'ConfiguredPackage' is assumed to not support Backpack. Only the --- @v2-build@ codepath supports Backpack. --- -data ConfiguredPackage loc = ConfiguredPackage { - confPkgId :: InstalledPackageId, - confPkgSource :: SourcePackage loc, -- package info, including repo - confPkgFlags :: FlagAssignment, -- complete flag assignment for the package - confPkgStanzas :: [OptionalStanza], -- list of enabled optional stanzas for the package - confPkgDeps :: ComponentDeps [ConfiguredId] - -- set of exact dependencies (installed or source). - -- These must be consistent with the 'buildDepends' - -- in the 'PackageDescription' that you'd get by - -- applying the flag assignment and optional stanzas. - } - deriving (Eq, Show, Generic) - --- | 'HasConfiguredId' indicates data types which have a 'ConfiguredId'. --- This type class is mostly used to conveniently finesse between --- 'ElaboratedPackage' and 'ElaboratedComponent'. --- -instance HasConfiguredId (ConfiguredPackage loc) where - configuredId pkg = ConfiguredId (packageId pkg) (Just (CLibName LMainLibName)) (confPkgId pkg) - --- 'ConfiguredPackage' is the legacy codepath, we are guaranteed --- to never have a nontrivial 'UnitId' -instance PackageFixedDeps (ConfiguredPackage loc) where - depends = fmap (map (newSimpleUnitId . confInstId)) . confPkgDeps - -instance IsNode (ConfiguredPackage loc) where - type Key (ConfiguredPackage loc) = UnitId - nodeKey = newSimpleUnitId . confPkgId - -- TODO: if we update ConfiguredPackage to support order-only - -- dependencies, need to include those here. - -- NB: have to deduplicate, otherwise the planner gets confused - nodeNeighbors = ordNub . CD.flatDeps . depends - -instance (Binary loc) => Binary (ConfiguredPackage loc) - - --- | A ConfiguredId is a package ID for a configured package. --- --- Once we configure a source package we know its UnitId. It is still --- however useful in lots of places to also know the source ID for the package. --- We therefore bundle the two. --- --- An already installed package of course is also "configured" (all its --- configuration parameters and dependencies have been specified). -data ConfiguredId = ConfiguredId { - confSrcId :: PackageId - , confCompName :: Maybe ComponentName - , confInstId :: ComponentId - } - deriving (Eq, Ord, Generic) - -annotatedIdToConfiguredId :: AnnotatedId ComponentId -> ConfiguredId -annotatedIdToConfiguredId aid = ConfiguredId { - confSrcId = ann_pid aid, - confCompName = Just (ann_cname aid), - confInstId = ann_id aid - } - -instance Binary ConfiguredId -instance Structured ConfiguredId - -instance Show ConfiguredId where - show cid = show (confInstId cid) - -instance Package ConfiguredId where - packageId = confSrcId - -instance Package (ConfiguredPackage loc) where - packageId cpkg = packageId (confPkgSource cpkg) - -instance HasMungedPackageId (ConfiguredPackage loc) where - mungedId cpkg = computeCompatPackageId (packageId cpkg) LMainLibName - --- Never has nontrivial UnitId -instance HasUnitId (ConfiguredPackage loc) where - installedUnitId = newSimpleUnitId . confPkgId - -instance PackageInstalled (ConfiguredPackage loc) where - installedDepends = CD.flatDeps . depends - -class HasConfiguredId a where - configuredId :: a -> ConfiguredId - --- NB: This instance is slightly dangerous, in that you'll lose --- information about the specific UnitId you depended on. -instance HasConfiguredId InstalledPackageInfo where - configuredId ipkg = ConfiguredId (packageId ipkg) - (Just (sourceComponentName ipkg)) - (installedComponentId ipkg) - --- | Like 'ConfiguredPackage', but with all dependencies guaranteed to be --- installed already, hence itself ready to be installed. -newtype GenericReadyPackage srcpkg = ReadyPackage srcpkg -- see 'ConfiguredPackage'. - deriving (Eq, Show, Generic, Package, PackageFixedDeps, - HasMungedPackageId, HasUnitId, PackageInstalled, Binary) - --- Can't newtype derive this -instance IsNode srcpkg => IsNode (GenericReadyPackage srcpkg) where - type Key (GenericReadyPackage srcpkg) = Key srcpkg - nodeKey (ReadyPackage spkg) = nodeKey spkg - nodeNeighbors (ReadyPackage spkg) = nodeNeighbors spkg - -type ReadyPackage = GenericReadyPackage (ConfiguredPackage UnresolvedPkgLoc) - --- | Convenience alias for 'SourcePackage UnresolvedPkgLoc'. -type UnresolvedSourcePackage = SourcePackage UnresolvedPkgLoc - - --- ------------------------------------------------------------ --- * Package specifier --- ------------------------------------------------------------ - --- | A fully or partially resolved reference to a package. --- -data PackageSpecifier pkg = - - -- | A partially specified reference to a package (either source or - -- installed). It is specified by package name and optionally some - -- required properties. Use a dependency resolver to pick a specific - -- package satisfying these properties. - -- - NamedPackage PackageName [PackageProperty] - - -- | A fully specified source package. - -- - | SpecificSourcePackage pkg - deriving (Eq, Show, Functor, Generic) - -instance Binary pkg => Binary (PackageSpecifier pkg) -instance Structured pkg => Structured (PackageSpecifier pkg) - -pkgSpecifierTarget :: Package pkg => PackageSpecifier pkg -> PackageName -pkgSpecifierTarget (NamedPackage name _) = name -pkgSpecifierTarget (SpecificSourcePackage pkg) = packageName pkg - -pkgSpecifierConstraints :: Package pkg - => PackageSpecifier pkg -> [LabeledPackageConstraint] -pkgSpecifierConstraints (NamedPackage name props) = map toLpc props - where - toLpc prop = LabeledPackageConstraint - (PackageConstraint (scopeToplevel name) prop) - ConstraintSourceUserTarget -pkgSpecifierConstraints (SpecificSourcePackage pkg) = - [LabeledPackageConstraint pc ConstraintSourceUserTarget] - where - pc = PackageConstraint - (ScopeTarget $ packageName pkg) - (PackagePropertyVersion $ thisVersion (packageVersion pkg)) - - --- ------------------------------------------------------------ --- * Package locations and repositories --- ------------------------------------------------------------ - --- | Repository name. --- --- May be used as path segment. --- -newtype RepoName = RepoName String - deriving (Show, Eq, Ord, Generic) - -unRepoName :: RepoName -> String -unRepoName (RepoName n) = n - -instance Binary RepoName -instance Structured RepoName -instance NFData RepoName - -instance Pretty RepoName where - pretty = Disp.text . unRepoName - -instance Parsec RepoName where - parsec = RepoName <$> - P.munch1 (\c -> isAlphaNum c || c == '_' || c == '-' || c == '.') - -instance Described RepoName where - describe _ = reMunch1CS $ csAlphaNum <> "_-." - -type UnresolvedPkgLoc = PackageLocation (Maybe FilePath) - -type ResolvedPkgLoc = PackageLocation FilePath - -data PackageLocation local = - - -- | An unpacked package in the given dir, or current dir - LocalUnpackedPackage FilePath - - -- | A package as a tarball that's available as a local tarball - | LocalTarballPackage FilePath - - -- | A package as a tarball from a remote URI - | RemoteTarballPackage URI local - - -- | A package available as a tarball from a repository. - -- - -- It may be from a local repository or from a remote repository, with a - -- locally cached copy. ie a package available from hackage - | RepoTarballPackage Repo PackageId local - - -- | A package available from a version control system source repository - | RemoteSourceRepoPackage SourceRepoMaybe local - deriving (Show, Functor, Eq, Ord, Generic, Typeable) - -instance Binary local => Binary (PackageLocation local) -instance Structured local => Structured (PackageLocation local) - -data RemoteRepo = - RemoteRepo { - remoteRepoName :: RepoName, - remoteRepoURI :: URI, - - -- | Enable secure access? - -- - -- 'Nothing' here represents "whatever the default is"; this is important - -- to allow for a smooth transition from opt-in to opt-out security - -- (once we switch to opt-out, all access to the central Hackage - -- repository should be secure by default) - remoteRepoSecure :: Maybe Bool, - - -- | Root key IDs (for bootstrapping) - remoteRepoRootKeys :: [String], - - -- | Threshold for verification during bootstrapping - remoteRepoKeyThreshold :: Int, - - -- | Normally a repo just specifies an HTTP or HTTPS URI, but as a - -- special case we may know a repo supports both and want to try HTTPS - -- if we can, but still allow falling back to HTTP. - -- - -- This field is not currently stored in the config file, but is filled - -- in automagically for known repos. - remoteRepoShouldTryHttps :: Bool - } - - deriving (Show, Eq, Ord, Generic) - -instance Binary RemoteRepo -instance Structured RemoteRepo - -instance Pretty RemoteRepo where - pretty r = - pretty (remoteRepoName r) <<>> Disp.colon <<>> - Disp.text (uriToString id (remoteRepoURI r) []) - --- | Note: serialised format represends 'RemoteRepo' only partially. -instance Parsec RemoteRepo where - parsec = do - name <- parsec - _ <- P.char ':' - uriStr <- P.munch1 (\c -> isAlphaNum c || c `elem` ("+-=._/*()@'$:;&!?~" :: String)) - uri <- maybe (fail $ "Cannot parse URI:" ++ uriStr) return (parseAbsoluteURI uriStr) - return RemoteRepo - { remoteRepoName = name - , remoteRepoURI = uri - , remoteRepoSecure = Nothing - , remoteRepoRootKeys = [] - , remoteRepoKeyThreshold = 0 - , remoteRepoShouldTryHttps = False - } - --- | Construct a partial 'RemoteRepo' value to fold the field parser list over. -emptyRemoteRepo :: RepoName -> RemoteRepo -emptyRemoteRepo name = RemoteRepo name nullURI Nothing [] 0 False - --- | /no-index/ style local repositories. --- --- https://github.com/haskell/cabal/issues/6359 -data LocalRepo = LocalRepo - { localRepoName :: RepoName - , localRepoPath :: FilePath - , localRepoSharedCache :: Bool - } - deriving (Show, Eq, Ord, Generic) - -instance Binary LocalRepo -instance Structured LocalRepo - --- | Note: doesn't parse 'localRepoSharedCache' field. -instance Parsec LocalRepo where - parsec = do - n <- parsec - _ <- P.char ':' - p <- P.munch1 (const True) -- restrict what can be a path? - return (LocalRepo n p False) - -instance Pretty LocalRepo where - pretty (LocalRepo n p _) = pretty n <<>> Disp.colon <<>> Disp.text p - --- | Construct a partial 'LocalRepo' value to fold the field parser list over. -emptyLocalRepo :: RepoName -> LocalRepo -emptyLocalRepo name = LocalRepo name "" False - --- | Calculate a cache key for local-repo. --- --- For remote repositories we just use name, but local repositories may --- all be named "local", so we add a bit of `localRepoPath` into the --- mix. -localRepoCacheKey :: LocalRepo -> String -localRepoCacheKey local = unRepoName (localRepoName local) ++ "-" ++ hashPart where - hashPart - = showHashValue $ truncateHash 8 $ hashValue - $ LBS.fromStrict $ toUTF8BS $ localRepoPath local - --- | Different kinds of repositories --- --- NOTE: It is important that this type remains serializable. -data Repo = - -- | Local repositories - RepoLocal { - repoLocalDir :: FilePath - } - - -- | Local repository, without index. - -- - -- https://github.com/haskell/cabal/issues/6359 - | RepoLocalNoIndex - { repoLocal :: LocalRepo - , repoLocalDir :: FilePath - } - - -- | Standard (unsecured) remote repositores - | RepoRemote { - repoRemote :: RemoteRepo - , repoLocalDir :: FilePath - } - - -- | Secure repositories - -- - -- Although this contains the same fields as 'RepoRemote', we use a separate - -- constructor to avoid confusing the two. - -- - -- Not all access to a secure repo goes through the hackage-security - -- library currently; code paths that do not still make use of the - -- 'repoRemote' and 'repoLocalDir' fields directly. - | RepoSecure { - repoRemote :: RemoteRepo - , repoLocalDir :: FilePath - } - deriving (Show, Eq, Ord, Generic) - -instance Binary Repo -instance Structured Repo - --- | Check if this is a remote repo -isRepoRemote :: Repo -> Bool -isRepoRemote RepoLocal{} = False -isRepoRemote RepoLocalNoIndex{} = False -isRepoRemote _ = True - --- | Extract @RemoteRepo@ from @Repo@ if remote. -maybeRepoRemote :: Repo -> Maybe RemoteRepo -maybeRepoRemote (RepoLocal _localDir) = Nothing -maybeRepoRemote (RepoLocalNoIndex _ _localDir) = Nothing -maybeRepoRemote (RepoRemote r _localDir) = Just r -maybeRepoRemote (RepoSecure r _localDir) = Just r - --- ------------------------------------------------------------ --- * Build results --- ------------------------------------------------------------ - --- | A summary of the outcome for building a single package. --- -type BuildOutcome = Either BuildFailure BuildResult - --- | A summary of the outcome for building a whole set of packages. --- -type BuildOutcomes = Map UnitId BuildOutcome - -data BuildFailure = PlanningFailed - | DependentFailed PackageId - | DownloadFailed SomeException - | UnpackFailed SomeException - | ConfigureFailed SomeException - | BuildFailed SomeException - | TestsFailed SomeException - | InstallFailed SomeException - deriving (Show, Typeable, Generic) - -instance Exception BuildFailure - --- Note that the @Maybe InstalledPackageInfo@ is a slight hack: we only --- the public library's 'InstalledPackageInfo' is stored here, even if --- there were 'InstalledPackageInfo' from internal libraries. This --- 'InstalledPackageInfo' is not used anyway, so it makes no difference. -data BuildResult = BuildResult DocsResult TestsResult - (Maybe InstalledPackageInfo) - deriving (Show, Generic) - -data DocsResult = DocsNotTried | DocsFailed | DocsOk - deriving (Show, Generic, Typeable) -data TestsResult = TestsNotTried | TestsOk - deriving (Show, Generic, Typeable) - -instance Binary BuildFailure -instance Binary BuildResult -instance Binary DocsResult -instance Binary TestsResult - -instance Structured BuildFailure -instance Structured BuildResult -instance Structured DocsResult -instance Structured TestsResult - --- ------------------------------------------------------------ --- * --allow-newer/--allow-older --- ------------------------------------------------------------ - --- TODO: When https://github.com/haskell/cabal/issues/4203 gets tackled, --- it may make sense to move these definitions to the Solver.Types --- module - --- | 'RelaxDeps' in the context of upper bounds (i.e. for @--allow-newer@ flag) -newtype AllowNewer = AllowNewer { unAllowNewer :: RelaxDeps } - deriving (Eq, Read, Show, Generic) - --- | 'RelaxDeps' in the context of lower bounds (i.e. for @--allow-older@ flag) -newtype AllowOlder = AllowOlder { unAllowOlder :: RelaxDeps } - deriving (Eq, Read, Show, Generic) - --- | Generic data type for policy when relaxing bounds in dependencies. --- Don't use this directly: use 'AllowOlder' or 'AllowNewer' depending --- on whether or not you are relaxing an lower or upper bound --- (respectively). -data RelaxDeps = - - -- | Ignore upper (resp. lower) bounds in some (or no) dependencies on the given packages. - -- - -- @RelaxDepsSome []@ is the default, i.e. honor the bounds in all - -- dependencies, never choose versions newer (resp. older) than allowed. - RelaxDepsSome [RelaxedDep] - - -- | Ignore upper (resp. lower) bounds in dependencies on all packages. - -- - -- __Note__: This is should be semantically equivalent to - -- - -- > RelaxDepsSome [RelaxedDep RelaxDepScopeAll RelaxDepModNone RelaxDepSubjectAll] - -- - -- (TODO: consider normalising 'RelaxDeps' and/or 'RelaxedDep') - | RelaxDepsAll - deriving (Eq, Read, Show, Generic) - --- | Dependencies can be relaxed either for all packages in the install plan, or --- only for some packages. -data RelaxedDep = RelaxedDep !RelaxDepScope !RelaxDepMod !RelaxDepSubject - deriving (Eq, Read, Show, Generic) - --- | Specify the scope of a relaxation, i.e. limit which depending --- packages are allowed to have their version constraints relaxed. -data RelaxDepScope = RelaxDepScopeAll - -- ^ Apply relaxation in any package - | RelaxDepScopePackage !PackageName - -- ^ Apply relaxation to in all versions of a package - | RelaxDepScopePackageId !PackageId - -- ^ Apply relaxation to a specific version of a package only - deriving (Eq, Read, Show, Generic) - --- | Modifier for dependency relaxation -data RelaxDepMod = RelaxDepModNone -- ^ Default semantics - | RelaxDepModCaret -- ^ Apply relaxation only to @^>=@ constraints - deriving (Eq, Read, Show, Generic) - --- | Express whether to relax bounds /on/ @all@ packages, or a single package -data RelaxDepSubject = RelaxDepSubjectAll - | RelaxDepSubjectPkg !PackageName - deriving (Eq, Ord, Read, Show, Generic) - -instance Text RelaxedDep where - disp (RelaxedDep scope rdmod subj) = case scope of - RelaxDepScopeAll -> Disp.text "all:" Disp.<> modDep - RelaxDepScopePackage p0 -> disp p0 Disp.<> Disp.colon Disp.<> modDep - RelaxDepScopePackageId p0 -> disp p0 Disp.<> Disp.colon Disp.<> modDep - where - modDep = case rdmod of - RelaxDepModNone -> disp subj - RelaxDepModCaret -> Disp.char '^' Disp.<> disp subj - - parse = RelaxedDep <$> scopeP <*> modP <*> parse - where - -- "greedy" choices - scopeP = (pure RelaxDepScopeAll <* Parse.char '*' <* Parse.char ':') - Parse.<++ (pure RelaxDepScopeAll <* Parse.string "all:") - Parse.<++ (RelaxDepScopePackageId <$> pidP <* Parse.char ':') - Parse.<++ (RelaxDepScopePackage <$> parse <* Parse.char ':') - Parse.<++ (pure RelaxDepScopeAll) - - modP = (pure RelaxDepModCaret <* Parse.char '^') - Parse.<++ (pure RelaxDepModNone) - - -- | Stricter 'PackageId' parser which doesn't overlap with 'PackageName' parser - pidP = do - p0 <- parse - when (pkgVersion p0 == nullVersion) Parse.pfail - pure p0 - -instance Text RelaxDepSubject where - disp RelaxDepSubjectAll = Disp.text "all" - disp (RelaxDepSubjectPkg pn) = disp pn - - parse = (pure RelaxDepSubjectAll <* Parse.char '*') Parse.<++ pkgn - where - pkgn = do - pn <- parse - pure (if (pn == mkPackageName "all") - then RelaxDepSubjectAll - else RelaxDepSubjectPkg pn) - -instance Text RelaxDeps where - disp rd | not (isRelaxDeps rd) = Disp.text "none" - disp (RelaxDepsSome pkgs) = Disp.fsep . - Disp.punctuate Disp.comma . - map disp $ pkgs - disp RelaxDepsAll = Disp.text "all" - - parse = (const mempty <$> ((Parse.string "none" Parse.+++ - Parse.string "None") <* Parse.eof)) - Parse.<++ (const RelaxDepsAll <$> ((Parse.string "all" Parse.+++ - Parse.string "All" Parse.+++ - Parse.string "*") <* Parse.eof)) - Parse.<++ ( RelaxDepsSome <$> parseOptCommaList parse) - -instance Binary RelaxDeps -instance Binary RelaxDepMod -instance Binary RelaxDepScope -instance Binary RelaxDepSubject -instance Binary RelaxedDep -instance Binary AllowNewer -instance Binary AllowOlder - -instance Structured RelaxDeps -instance Structured RelaxDepMod -instance Structured RelaxDepScope -instance Structured RelaxDepSubject -instance Structured RelaxedDep -instance Structured AllowNewer -instance Structured AllowOlder - --- | Return 'True' if 'RelaxDeps' specifies a non-empty set of relaxations --- --- Equivalent to @isRelaxDeps = (/= 'mempty')@ -isRelaxDeps :: RelaxDeps -> Bool -isRelaxDeps (RelaxDepsSome []) = False -isRelaxDeps (RelaxDepsSome (_:_)) = True -isRelaxDeps RelaxDepsAll = True - --- | 'RelaxDepsAll' is the /absorbing element/ -instance Semigroup RelaxDeps where - -- identity element - RelaxDepsSome [] <> r = r - l@(RelaxDepsSome _) <> RelaxDepsSome [] = l - -- absorbing element - l@RelaxDepsAll <> _ = l - (RelaxDepsSome _) <> r@RelaxDepsAll = r - -- combining non-{identity,absorbing} elements - (RelaxDepsSome a) <> (RelaxDepsSome b) = RelaxDepsSome (a ++ b) - --- | @'RelaxDepsSome' []@ is the /identity element/ -instance Monoid RelaxDeps where - mempty = RelaxDepsSome [] - mappend = (<>) - -instance Semigroup AllowNewer where - AllowNewer x <> AllowNewer y = AllowNewer (x <> y) - -instance Semigroup AllowOlder where - AllowOlder x <> AllowOlder y = AllowOlder (x <> y) - -instance Monoid AllowNewer where - mempty = AllowNewer mempty - mappend = (<>) - -instance Monoid AllowOlder where - mempty = AllowOlder mempty - mappend = (<>) - --- ------------------------------------------------------------ --- * --write-ghc-environment-file --- ------------------------------------------------------------ - --- | Whether 'v2-build' should write a .ghc.environment file after --- success. Possible values: 'always', 'never' (the default), 'ghc8.4.4+' --- (8.4.4 is the earliest version that supports --- '-package-env -'). -data WriteGhcEnvironmentFilesPolicy - = AlwaysWriteGhcEnvironmentFiles - | NeverWriteGhcEnvironmentFiles - | WriteGhcEnvironmentFilesOnlyForGhc844AndNewer - deriving (Eq, Enum, Bounded, Generic, Show) - -instance Binary WriteGhcEnvironmentFilesPolicy -instance Structured WriteGhcEnvironmentFilesPolicy +module Distribution.Client.Types ( + module Distribution.Client.Types.AllowNewer, + module Distribution.Client.Types.ConfiguredId, + module Distribution.Client.Types.ConfiguredPackage, + module Distribution.Client.Types.BuildResults, + module Distribution.Client.Types.PackageLocation, + module Distribution.Client.Types.PackageSpecifier, + module Distribution.Client.Types.ReadyPackage, + module Distribution.Client.Types.Repo, + module Distribution.Client.Types.RepoName, + module Distribution.Client.Types.SourcePackageDb, + module Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy, +) where + + +import Distribution.Client.Types.AllowNewer +import Distribution.Client.Types.BuildResults +import Distribution.Client.Types.ConfiguredId +import Distribution.Client.Types.ConfiguredPackage +import Distribution.Client.Types.PackageLocation +import Distribution.Client.Types.PackageSpecifier +import Distribution.Client.Types.Repo +import Distribution.Client.Types.RepoName +import Distribution.Client.Types.ReadyPackage +import Distribution.Client.Types.SourcePackageDb +import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy diff --git a/cabal-install/Distribution/Client/Types/AllowNewer.hs b/cabal-install/Distribution/Client/Types/AllowNewer.hs new file mode 100644 index 00000000000..32b885ff5f5 --- /dev/null +++ b/cabal-install/Distribution/Client/Types/AllowNewer.hs @@ -0,0 +1,191 @@ +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Client.Types.AllowNewer ( + AllowNewer (..), + AllowOlder (..), + RelaxDeps (..), + RelaxDepMod (..), + RelaxDepScope (..), + RelaxDepSubject (..), + RelaxedDep (..), + isRelaxDeps, +) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Distribution.Types.PackageId (PackageId, pkgVersion) +import Distribution.Types.PackageName (PackageName, mkPackageName) +import Distribution.Types.Version (nullVersion) + +import qualified Text.PrettyPrint as Disp + +import Distribution.Deprecated.ParseUtils (parseOptCommaList) +import qualified Distribution.Deprecated.ReadP as Parse +import Distribution.Deprecated.Text (Text (..)) + +-- TODO: When https://github.com/haskell/cabal/issues/4203 gets tackled, +-- it may make sense to move these definitions to the Solver.Types +-- module + +-- | 'RelaxDeps' in the context of upper bounds (i.e. for @--allow-newer@ flag) +newtype AllowNewer = AllowNewer { unAllowNewer :: RelaxDeps } + deriving (Eq, Read, Show, Generic) + +-- | 'RelaxDeps' in the context of lower bounds (i.e. for @--allow-older@ flag) +newtype AllowOlder = AllowOlder { unAllowOlder :: RelaxDeps } + deriving (Eq, Read, Show, Generic) + +-- | Generic data type for policy when relaxing bounds in dependencies. +-- Don't use this directly: use 'AllowOlder' or 'AllowNewer' depending +-- on whether or not you are relaxing an lower or upper bound +-- (respectively). +data RelaxDeps = + + -- | Ignore upper (resp. lower) bounds in some (or no) dependencies on the given packages. + -- + -- @RelaxDepsSome []@ is the default, i.e. honor the bounds in all + -- dependencies, never choose versions newer (resp. older) than allowed. + RelaxDepsSome [RelaxedDep] + + -- | Ignore upper (resp. lower) bounds in dependencies on all packages. + -- + -- __Note__: This is should be semantically equivalent to + -- + -- > RelaxDepsSome [RelaxedDep RelaxDepScopeAll RelaxDepModNone RelaxDepSubjectAll] + -- + -- (TODO: consider normalising 'RelaxDeps' and/or 'RelaxedDep') + | RelaxDepsAll + deriving (Eq, Read, Show, Generic) + +-- | Dependencies can be relaxed either for all packages in the install plan, or +-- only for some packages. +data RelaxedDep = RelaxedDep !RelaxDepScope !RelaxDepMod !RelaxDepSubject + deriving (Eq, Read, Show, Generic) + +-- | Specify the scope of a relaxation, i.e. limit which depending +-- packages are allowed to have their version constraints relaxed. +data RelaxDepScope = RelaxDepScopeAll + -- ^ Apply relaxation in any package + | RelaxDepScopePackage !PackageName + -- ^ Apply relaxation to in all versions of a package + | RelaxDepScopePackageId !PackageId + -- ^ Apply relaxation to a specific version of a package only + deriving (Eq, Read, Show, Generic) + +-- | Modifier for dependency relaxation +data RelaxDepMod = RelaxDepModNone -- ^ Default semantics + | RelaxDepModCaret -- ^ Apply relaxation only to @^>=@ constraints + deriving (Eq, Read, Show, Generic) + +-- | Express whether to relax bounds /on/ @all@ packages, or a single package +data RelaxDepSubject = RelaxDepSubjectAll + | RelaxDepSubjectPkg !PackageName + deriving (Eq, Ord, Read, Show, Generic) + +instance Text RelaxedDep where + disp (RelaxedDep scope rdmod subj) = case scope of + RelaxDepScopeAll -> Disp.text "all:" Disp.<> modDep + RelaxDepScopePackage p0 -> disp p0 Disp.<> Disp.colon Disp.<> modDep + RelaxDepScopePackageId p0 -> disp p0 Disp.<> Disp.colon Disp.<> modDep + where + modDep = case rdmod of + RelaxDepModNone -> disp subj + RelaxDepModCaret -> Disp.char '^' Disp.<> disp subj + + parse = RelaxedDep <$> scopeP <*> modP <*> parse + where + -- "greedy" choices + scopeP = (pure RelaxDepScopeAll <* Parse.char '*' <* Parse.char ':') + Parse.<++ (pure RelaxDepScopeAll <* Parse.string "all:") + Parse.<++ (RelaxDepScopePackageId <$> pidP <* Parse.char ':') + Parse.<++ (RelaxDepScopePackage <$> parse <* Parse.char ':') + Parse.<++ (pure RelaxDepScopeAll) + + modP = (pure RelaxDepModCaret <* Parse.char '^') + Parse.<++ (pure RelaxDepModNone) + + -- | Stricter 'PackageId' parser which doesn't overlap with 'PackageName' parser + pidP = do + p0 <- parse + when (pkgVersion p0 == nullVersion) Parse.pfail + pure p0 + +instance Text RelaxDepSubject where + disp RelaxDepSubjectAll = Disp.text "all" + disp (RelaxDepSubjectPkg pn) = disp pn + + parse = (pure RelaxDepSubjectAll <* Parse.char '*') Parse.<++ pkgn + where + pkgn = do + pn <- parse + pure (if (pn == mkPackageName "all") + then RelaxDepSubjectAll + else RelaxDepSubjectPkg pn) + +instance Text RelaxDeps where + disp rd | not (isRelaxDeps rd) = Disp.text "none" + disp (RelaxDepsSome pkgs) = Disp.fsep . + Disp.punctuate Disp.comma . + map disp $ pkgs + disp RelaxDepsAll = Disp.text "all" + + parse = (const mempty <$> ((Parse.string "none" Parse.+++ + Parse.string "None") <* Parse.eof)) + Parse.<++ (const RelaxDepsAll <$> ((Parse.string "all" Parse.+++ + Parse.string "All" Parse.+++ + Parse.string "*") <* Parse.eof)) + Parse.<++ ( RelaxDepsSome <$> parseOptCommaList parse) + +instance Binary RelaxDeps +instance Binary RelaxDepMod +instance Binary RelaxDepScope +instance Binary RelaxDepSubject +instance Binary RelaxedDep +instance Binary AllowNewer +instance Binary AllowOlder + +instance Structured RelaxDeps +instance Structured RelaxDepMod +instance Structured RelaxDepScope +instance Structured RelaxDepSubject +instance Structured RelaxedDep +instance Structured AllowNewer +instance Structured AllowOlder + +-- | Return 'True' if 'RelaxDeps' specifies a non-empty set of relaxations +-- +-- Equivalent to @isRelaxDeps = (/= 'mempty')@ +isRelaxDeps :: RelaxDeps -> Bool +isRelaxDeps (RelaxDepsSome []) = False +isRelaxDeps (RelaxDepsSome (_:_)) = True +isRelaxDeps RelaxDepsAll = True + +-- | 'RelaxDepsAll' is the /absorbing element/ +instance Semigroup RelaxDeps where + -- identity element + RelaxDepsSome [] <> r = r + l@(RelaxDepsSome _) <> RelaxDepsSome [] = l + -- absorbing element + l@RelaxDepsAll <> _ = l + (RelaxDepsSome _) <> r@RelaxDepsAll = r + -- combining non-{identity,absorbing} elements + (RelaxDepsSome a) <> (RelaxDepsSome b) = RelaxDepsSome (a ++ b) + +-- | @'RelaxDepsSome' []@ is the /identity element/ +instance Monoid RelaxDeps where + mempty = RelaxDepsSome [] + mappend = (<>) + +instance Semigroup AllowNewer where + AllowNewer x <> AllowNewer y = AllowNewer (x <> y) + +instance Semigroup AllowOlder where + AllowOlder x <> AllowOlder y = AllowOlder (x <> y) + +instance Monoid AllowNewer where + mempty = AllowNewer mempty + mappend = (<>) + +instance Monoid AllowOlder where + mempty = AllowOlder mempty + mappend = (<>) diff --git a/cabal-install/Distribution/Client/Types/BuildResults.hs b/cabal-install/Distribution/Client/Types/BuildResults.hs new file mode 100644 index 00000000000..4ecea97a2fb --- /dev/null +++ b/cabal-install/Distribution/Client/Types/BuildResults.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Client.Types.BuildResults ( + BuildOutcome, + BuildOutcomes, + BuildFailure (..), + BuildResult (..), + TestsResult (..), + DocsResult (..), +) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Control.Exception (Exception, SomeException) + +import Distribution.Types.InstalledPackageInfo (InstalledPackageInfo) +import Distribution.Types.PackageId (PackageId) +import Distribution.Types.UnitId (UnitId) + +-- | A summary of the outcome for building a single package. +-- +type BuildOutcome = Either BuildFailure BuildResult + +-- | A summary of the outcome for building a whole set of packages. +-- +type BuildOutcomes = Map UnitId BuildOutcome + +data BuildFailure = PlanningFailed + | DependentFailed PackageId + | DownloadFailed SomeException + | UnpackFailed SomeException + | ConfigureFailed SomeException + | BuildFailed SomeException + | TestsFailed SomeException + | InstallFailed SomeException + deriving (Show, Typeable, Generic) + +instance Exception BuildFailure + +-- Note that the @Maybe InstalledPackageInfo@ is a slight hack: we only +-- the public library's 'InstalledPackageInfo' is stored here, even if +-- there were 'InstalledPackageInfo' from internal libraries. This +-- 'InstalledPackageInfo' is not used anyway, so it makes no difference. +data BuildResult = BuildResult DocsResult TestsResult + (Maybe InstalledPackageInfo) + deriving (Show, Generic) + +data DocsResult = DocsNotTried | DocsFailed | DocsOk + deriving (Show, Generic, Typeable) +data TestsResult = TestsNotTried | TestsOk + deriving (Show, Generic, Typeable) + +instance Binary BuildFailure +instance Binary BuildResult +instance Binary DocsResult +instance Binary TestsResult + +instance Structured BuildFailure +instance Structured BuildResult +instance Structured DocsResult +instance Structured TestsResult diff --git a/cabal-install/Distribution/Client/Types/ConfiguredId.hs b/cabal-install/Distribution/Client/Types/ConfiguredId.hs new file mode 100644 index 00000000000..4537d20ea28 --- /dev/null +++ b/cabal-install/Distribution/Client/Types/ConfiguredId.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Client.Types.ConfiguredId ( + InstalledPackageId, + ConfiguredId (..), + annotatedIdToConfiguredId, + HasConfiguredId (..), +) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Distribution.InstalledPackageInfo (InstalledPackageInfo, sourceComponentName, installedComponentId) +import Distribution.Package (Package (..)) +import Distribution.Types.AnnotatedId (AnnotatedId (..)) +import Distribution.Types.ComponentId (ComponentId) +import Distribution.Types.ComponentName (ComponentName) +import Distribution.Types.PackageId (PackageId) + +------------------------------------------------------------------------------- +-- InstalledPackageId +------------------------------------------------------------------------------- + +-- | Within Cabal the library we no longer have a @InstalledPackageId@ type. +-- That's because it deals with the compilers' notion of a registered library, +-- and those really are libraries not packages. Those are now named units. +-- +-- The package management layer does however deal with installed packages, as +-- whole packages not just as libraries. So we do still need a type for +-- installed package ids. At the moment however we track instaled packages via +-- their primary library, which is a unit id. In future this may change +-- slightly and we may distinguish these two types and have an explicit +-- conversion when we register units with the compiler. +-- +type InstalledPackageId = ComponentId + +------------------------------------------------------------------------------- +-- ConfiguredId +------------------------------------------------------------------------------- + +-- | A ConfiguredId is a package ID for a configured package. +-- +-- Once we configure a source package we know its UnitId. It is still +-- however useful in lots of places to also know the source ID for the package. +-- We therefore bundle the two. +-- +-- An already installed package of course is also "configured" (all its +-- configuration parameters and dependencies have been specified). +data ConfiguredId = ConfiguredId { + confSrcId :: PackageId + , confCompName :: Maybe ComponentName + , confInstId :: ComponentId + } + deriving (Eq, Ord, Generic) + +annotatedIdToConfiguredId :: AnnotatedId ComponentId -> ConfiguredId +annotatedIdToConfiguredId aid = ConfiguredId { + confSrcId = ann_pid aid, + confCompName = Just (ann_cname aid), + confInstId = ann_id aid + } + +instance Binary ConfiguredId +instance Structured ConfiguredId + +instance Show ConfiguredId where + show cid = show (confInstId cid) + +instance Package ConfiguredId where + packageId = confSrcId + +------------------------------------------------------------------------------- +-- HasConfiguredId class +------------------------------------------------------------------------------- + +class HasConfiguredId a where + configuredId :: a -> ConfiguredId + +-- NB: This instance is slightly dangerous, in that you'll lose +-- information about the specific UnitId you depended on. +instance HasConfiguredId InstalledPackageInfo where + configuredId ipkg = ConfiguredId (packageId ipkg) + (Just (sourceComponentName ipkg)) + (installedComponentId ipkg) diff --git a/cabal-install/Distribution/Client/Types/ConfiguredPackage.hs b/cabal-install/Distribution/Client/Types/ConfiguredPackage.hs new file mode 100644 index 00000000000..558d3ef17ae --- /dev/null +++ b/cabal-install/Distribution/Client/Types/ConfiguredPackage.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeFamilies #-} +module Distribution.Client.Types.ConfiguredPackage ( + ConfiguredPackage (..), +) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Distribution.Compat.Graph (IsNode (..)) +import Distribution.Package (newSimpleUnitId, HasMungedPackageId (..), HasUnitId (..), Package (..), PackageInstalled (..), UnitId) +import Distribution.Types.Flag (FlagAssignment) +import Distribution.Types.ComponentName +import Distribution.Types.LibraryName (LibraryName (..)) +import Distribution.Types.MungedPackageId (computeCompatPackageId) +import Distribution.Simple.Utils (ordNub) + +import Distribution.Client.Types.ConfiguredId +import Distribution.Solver.Types.OptionalStanza (OptionalStanza) +import Distribution.Solver.Types.PackageFixedDeps +import Distribution.Solver.Types.SourcePackage (SourcePackage) + +import qualified Distribution.Solver.Types.ComponentDeps as CD + +-- | A 'ConfiguredPackage' is a not-yet-installed package along with the +-- total configuration information. The configuration information is total in +-- the sense that it provides all the configuration information and so the +-- final configure process will be independent of the environment. +-- +-- 'ConfiguredPackage' is assumed to not support Backpack. Only the +-- @v2-build@ codepath supports Backpack. +-- +data ConfiguredPackage loc = ConfiguredPackage + { confPkgId :: InstalledPackageId + , confPkgSource :: SourcePackage loc -- ^ package info, including repo + , confPkgFlags :: FlagAssignment -- ^ complete flag assignment for the package + , confPkgStanzas :: [OptionalStanza] -- ^ list of enabled optional stanzas for the package + , confPkgDeps :: CD.ComponentDeps [ConfiguredId] + -- ^ set of exact dependencies (installed or source). + -- + -- These must be consistent with the 'buildDepends' + -- in the 'PackageDescription' that you'd get by + -- applying the flag assignment and optional stanzas. + } + deriving (Eq, Show, Generic) + +-- | 'HasConfiguredId' indicates data types which have a 'ConfiguredId'. +-- This type class is mostly used to conveniently finesse between +-- 'ElaboratedPackage' and 'ElaboratedComponent'. +-- +instance HasConfiguredId (ConfiguredPackage loc) where + configuredId pkg = ConfiguredId (packageId pkg) (Just (CLibName LMainLibName)) (confPkgId pkg) + +-- 'ConfiguredPackage' is the legacy codepath, we are guaranteed +-- to never have a nontrivial 'UnitId' +instance PackageFixedDeps (ConfiguredPackage loc) where + depends = fmap (map (newSimpleUnitId . confInstId)) . confPkgDeps + +instance IsNode (ConfiguredPackage loc) where + type Key (ConfiguredPackage loc) = UnitId + nodeKey = newSimpleUnitId . confPkgId + -- TODO: if we update ConfiguredPackage to support order-only + -- dependencies, need to include those here. + -- NB: have to deduplicate, otherwise the planner gets confused + nodeNeighbors = ordNub . CD.flatDeps . depends + +instance (Binary loc) => Binary (ConfiguredPackage loc) + + + + +instance Package (ConfiguredPackage loc) where + packageId cpkg = packageId (confPkgSource cpkg) + +instance HasMungedPackageId (ConfiguredPackage loc) where + mungedId cpkg = computeCompatPackageId (packageId cpkg) LMainLibName + +-- Never has nontrivial UnitId +instance HasUnitId (ConfiguredPackage loc) where + installedUnitId = newSimpleUnitId . confPkgId + +instance PackageInstalled (ConfiguredPackage loc) where + installedDepends = CD.flatDeps . depends + + + diff --git a/cabal-install/Distribution/Client/Types/Credentials.hs b/cabal-install/Distribution/Client/Types/Credentials.hs new file mode 100644 index 00000000000..89be60a8af1 --- /dev/null +++ b/cabal-install/Distribution/Client/Types/Credentials.hs @@ -0,0 +1,7 @@ +module Distribution.Client.Types.Credentials ( + Username (..), + Password (..), +) where + +newtype Username = Username { unUsername :: String } +newtype Password = Password { unPassword :: String } diff --git a/cabal-install/Distribution/Client/Types/PackageLocation.hs b/cabal-install/Distribution/Client/Types/PackageLocation.hs new file mode 100644 index 00000000000..2038781bbba --- /dev/null +++ b/cabal-install/Distribution/Client/Types/PackageLocation.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Client.Types.PackageLocation ( + PackageLocation (..), + UnresolvedPkgLoc, + ResolvedPkgLoc, + UnresolvedSourcePackage, +) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Network.URI (URI) + +import Distribution.Types.PackageId (PackageId) + +import Distribution.Client.Types.Repo +import Distribution.Client.Types.SourceRepo (SourceRepoMaybe) +import Distribution.Solver.Types.SourcePackage (SourcePackage) + +type UnresolvedPkgLoc = PackageLocation (Maybe FilePath) + +type ResolvedPkgLoc = PackageLocation FilePath + +data PackageLocation local = + + -- | An unpacked package in the given dir, or current dir + LocalUnpackedPackage FilePath + + -- | A package as a tarball that's available as a local tarball + | LocalTarballPackage FilePath + + -- | A package as a tarball from a remote URI + | RemoteTarballPackage URI local + + -- | A package available as a tarball from a repository. + -- + -- It may be from a local repository or from a remote repository, with a + -- locally cached copy. ie a package available from hackage + | RepoTarballPackage Repo PackageId local + + -- | A package available from a version control system source repository + | RemoteSourceRepoPackage SourceRepoMaybe local + deriving (Show, Functor, Eq, Ord, Generic, Typeable) + +instance Binary local => Binary (PackageLocation local) +instance Structured local => Structured (PackageLocation local) + +-- | Convenience alias for 'SourcePackage UnresolvedPkgLoc'. +type UnresolvedSourcePackage = SourcePackage UnresolvedPkgLoc diff --git a/cabal-install/Distribution/Client/Types/PackageSpecifier.hs b/cabal-install/Distribution/Client/Types/PackageSpecifier.hs new file mode 100644 index 00000000000..3fbe0265d4f --- /dev/null +++ b/cabal-install/Distribution/Client/Types/PackageSpecifier.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Client.Types.PackageSpecifier ( + PackageSpecifier (..), + pkgSpecifierTarget, + pkgSpecifierConstraints, +) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Distribution.Package (Package (..), packageName, packageVersion) +import Distribution.Types.PackageName (PackageName) +import Distribution.Version (thisVersion) + +import Distribution.Solver.Types.ConstraintSource +import Distribution.Solver.Types.LabeledPackageConstraint +import Distribution.Solver.Types.PackageConstraint + +-- | A fully or partially resolved reference to a package. +-- +data PackageSpecifier pkg = + + -- | A partially specified reference to a package (either source or + -- installed). It is specified by package name and optionally some + -- required properties. Use a dependency resolver to pick a specific + -- package satisfying these properties. + -- + NamedPackage PackageName [PackageProperty] + + -- | A fully specified source package. + -- + | SpecificSourcePackage pkg + deriving (Eq, Show, Functor, Generic) + +instance Binary pkg => Binary (PackageSpecifier pkg) +instance Structured pkg => Structured (PackageSpecifier pkg) + +pkgSpecifierTarget :: Package pkg => PackageSpecifier pkg -> PackageName +pkgSpecifierTarget (NamedPackage name _) = name +pkgSpecifierTarget (SpecificSourcePackage pkg) = packageName pkg + +pkgSpecifierConstraints :: Package pkg + => PackageSpecifier pkg -> [LabeledPackageConstraint] +pkgSpecifierConstraints (NamedPackage name props) = map toLpc props + where + toLpc prop = LabeledPackageConstraint + (PackageConstraint (scopeToplevel name) prop) + ConstraintSourceUserTarget +pkgSpecifierConstraints (SpecificSourcePackage pkg) = + [LabeledPackageConstraint pc ConstraintSourceUserTarget] + where + pc = PackageConstraint + (ScopeTarget $ packageName pkg) + (PackagePropertyVersion $ thisVersion (packageVersion pkg)) diff --git a/cabal-install/Distribution/Client/Types/Packages.hs b/cabal-install/Distribution/Client/Types/Packages.hs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-install/Distribution/Client/Types/ReadyPackage.hs b/cabal-install/Distribution/Client/Types/ReadyPackage.hs new file mode 100644 index 00000000000..8a526a24817 --- /dev/null +++ b/cabal-install/Distribution/Client/Types/ReadyPackage.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Distribution.Client.Types.ReadyPackage ( + GenericReadyPackage (..), + ReadyPackage, +) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Distribution.Compat.Graph (IsNode (..)) +import Distribution.Package (HasMungedPackageId, HasUnitId, Package, PackageInstalled) + +import Distribution.Client.Types.ConfiguredPackage (ConfiguredPackage) +import Distribution.Client.Types.PackageLocation (UnresolvedPkgLoc) +import Distribution.Solver.Types.PackageFixedDeps + +-- | Like 'ConfiguredPackage', but with all dependencies guaranteed to be +-- installed already, hence itself ready to be installed. +newtype GenericReadyPackage srcpkg = ReadyPackage srcpkg -- see 'ConfiguredPackage'. + deriving (Eq, Show, Generic, Package, PackageFixedDeps, + HasMungedPackageId, HasUnitId, PackageInstalled, Binary) + +-- Can't newtype derive this +instance IsNode srcpkg => IsNode (GenericReadyPackage srcpkg) where + type Key (GenericReadyPackage srcpkg) = Key srcpkg + nodeKey (ReadyPackage spkg) = nodeKey spkg + nodeNeighbors (ReadyPackage spkg) = nodeNeighbors spkg + +type ReadyPackage = GenericReadyPackage (ConfiguredPackage UnresolvedPkgLoc) diff --git a/cabal-install/Distribution/Client/Types/Repo.hs b/cabal-install/Distribution/Client/Types/Repo.hs new file mode 100644 index 00000000000..7b1065150c3 --- /dev/null +++ b/cabal-install/Distribution/Client/Types/Repo.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Client.Types.Repo ( + -- * Remote repository + RemoteRepo (..), + emptyRemoteRepo, + -- * Local repository (no-index) + LocalRepo (..), + emptyLocalRepo, + localRepoCacheKey, + -- * Repository + Repo (..), + isRepoRemote, + maybeRepoRemote, +) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Network.URI (URI (..), nullURI, parseAbsoluteURI, uriToString) + +import Distribution.Parsec (Parsec (..)) +import Distribution.Pretty (Pretty (..)) +import Distribution.Simple.Utils (toUTF8BS) + +import Distribution.Client.HashValue (hashValue, showHashValue, truncateHash) + +import qualified Data.ByteString.Lazy.Char8 as LBS +import qualified Distribution.Compat.CharParsing as P +import qualified Text.PrettyPrint as Disp + +import Distribution.Client.Types.RepoName + +------------------------------------------------------------------------------- +-- Remote repository +------------------------------------------------------------------------------- + +data RemoteRepo = + RemoteRepo { + remoteRepoName :: RepoName, + remoteRepoURI :: URI, + + -- | Enable secure access? + -- + -- 'Nothing' here represents "whatever the default is"; this is important + -- to allow for a smooth transition from opt-in to opt-out security + -- (once we switch to opt-out, all access to the central Hackage + -- repository should be secure by default) + remoteRepoSecure :: Maybe Bool, + + -- | Root key IDs (for bootstrapping) + remoteRepoRootKeys :: [String], + + -- | Threshold for verification during bootstrapping + remoteRepoKeyThreshold :: Int, + + -- | Normally a repo just specifies an HTTP or HTTPS URI, but as a + -- special case we may know a repo supports both and want to try HTTPS + -- if we can, but still allow falling back to HTTP. + -- + -- This field is not currently stored in the config file, but is filled + -- in automagically for known repos. + remoteRepoShouldTryHttps :: Bool + } + + deriving (Show, Eq, Ord, Generic) + +instance Binary RemoteRepo +instance Structured RemoteRepo + +instance Pretty RemoteRepo where + pretty r = + pretty (remoteRepoName r) <<>> Disp.colon <<>> + Disp.text (uriToString id (remoteRepoURI r) []) + +-- | Note: serialised format represends 'RemoteRepo' only partially. +instance Parsec RemoteRepo where + parsec = do + name <- parsec + _ <- P.char ':' + uriStr <- P.munch1 (\c -> isAlphaNum c || c `elem` ("+-=._/*()@'$:;&!?~" :: String)) + uri <- maybe (fail $ "Cannot parse URI:" ++ uriStr) return (parseAbsoluteURI uriStr) + return RemoteRepo + { remoteRepoName = name + , remoteRepoURI = uri + , remoteRepoSecure = Nothing + , remoteRepoRootKeys = [] + , remoteRepoKeyThreshold = 0 + , remoteRepoShouldTryHttps = False + } + +-- | Construct a partial 'RemoteRepo' value to fold the field parser list over. +emptyRemoteRepo :: RepoName -> RemoteRepo +emptyRemoteRepo name = RemoteRepo name nullURI Nothing [] 0 False + +------------------------------------------------------------------------------- +-- Local repository +------------------------------------------------------------------------------- + +-- | /no-index/ style local repositories. +-- +-- https://github.com/haskell/cabal/issues/6359 +data LocalRepo = LocalRepo + { localRepoName :: RepoName + , localRepoPath :: FilePath + , localRepoSharedCache :: Bool + } + deriving (Show, Eq, Ord, Generic) + +instance Binary LocalRepo +instance Structured LocalRepo + +-- | Note: doesn't parse 'localRepoSharedCache' field. +instance Parsec LocalRepo where + parsec = do + n <- parsec + _ <- P.char ':' + p <- P.munch1 (const True) -- restrict what can be a path? + return (LocalRepo n p False) + +instance Pretty LocalRepo where + pretty (LocalRepo n p _) = pretty n <<>> Disp.colon <<>> Disp.text p + +-- | Construct a partial 'LocalRepo' value to fold the field parser list over. +emptyLocalRepo :: RepoName -> LocalRepo +emptyLocalRepo name = LocalRepo name "" False + +-- | Calculate a cache key for local-repo. +-- +-- For remote repositories we just use name, but local repositories may +-- all be named "local", so we add a bit of `localRepoPath` into the +-- mix. +localRepoCacheKey :: LocalRepo -> String +localRepoCacheKey local = unRepoName (localRepoName local) ++ "-" ++ hashPart where + hashPart + = showHashValue $ truncateHash 8 $ hashValue + $ LBS.fromStrict $ toUTF8BS $ localRepoPath local + +------------------------------------------------------------------------------- +-- Any repository +------------------------------------------------------------------------------- + +-- | Different kinds of repositories +-- +-- NOTE: It is important that this type remains serializable. +data Repo = + -- | Local repositories + RepoLocal { + repoLocalDir :: FilePath + } + + -- | Local repository, without index. + -- + -- https://github.com/haskell/cabal/issues/6359 + | RepoLocalNoIndex + { repoLocal :: LocalRepo + , repoLocalDir :: FilePath + } + + -- | Standard (unsecured) remote repositores + | RepoRemote { + repoRemote :: RemoteRepo + , repoLocalDir :: FilePath + } + + -- | Secure repositories + -- + -- Although this contains the same fields as 'RepoRemote', we use a separate + -- constructor to avoid confusing the two. + -- + -- Not all access to a secure repo goes through the hackage-security + -- library currently; code paths that do not still make use of the + -- 'repoRemote' and 'repoLocalDir' fields directly. + | RepoSecure { + repoRemote :: RemoteRepo + , repoLocalDir :: FilePath + } + deriving (Show, Eq, Ord, Generic) + +instance Binary Repo +instance Structured Repo + +-- | Check if this is a remote repo +isRepoRemote :: Repo -> Bool +isRepoRemote RepoLocal{} = False +isRepoRemote RepoLocalNoIndex{} = False +isRepoRemote _ = True + +-- | Extract @RemoteRepo@ from @Repo@ if remote. +maybeRepoRemote :: Repo -> Maybe RemoteRepo +maybeRepoRemote (RepoLocal _localDir) = Nothing +maybeRepoRemote (RepoLocalNoIndex _ _localDir) = Nothing +maybeRepoRemote (RepoRemote r _localDir) = Just r +maybeRepoRemote (RepoSecure r _localDir) = Just r diff --git a/cabal-install/Distribution/Client/Types/RepoName.hs b/cabal-install/Distribution/Client/Types/RepoName.hs new file mode 100644 index 00000000000..5e7aae4456c --- /dev/null +++ b/cabal-install/Distribution/Client/Types/RepoName.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Client.Types.RepoName ( + RepoName (..), + unRepoName, +) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Distribution.FieldGrammar.Described (Described (..), csAlphaNum, reMunch1CS) +import Distribution.Parsec (Parsec (..)) +import Distribution.Pretty (Pretty (..)) + +import qualified Distribution.Compat.CharParsing as P +import qualified Text.PrettyPrint as Disp + +-- | Repository name. +-- +-- May be used as path segment. +-- +newtype RepoName = RepoName String + deriving (Show, Eq, Ord, Generic) + +unRepoName :: RepoName -> String +unRepoName (RepoName n) = n + +instance Binary RepoName +instance Structured RepoName +instance NFData RepoName + +instance Pretty RepoName where + pretty = Disp.text . unRepoName + +instance Parsec RepoName where + parsec = RepoName <$> + P.munch1 (\c -> isAlphaNum c || c == '_' || c == '-' || c == '.') + +instance Described RepoName where + describe _ = reMunch1CS $ csAlphaNum <> fromString "_-." diff --git a/cabal-install/Distribution/Client/Types/SourcePackageDb.hs b/cabal-install/Distribution/Client/Types/SourcePackageDb.hs new file mode 100644 index 00000000000..bbd62c56aaf --- /dev/null +++ b/cabal-install/Distribution/Client/Types/SourcePackageDb.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Client.Types.SourcePackageDb ( + SourcePackageDb (..), +) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Distribution.Types.PackageName (PackageName) +import Distribution.Types.VersionRange (VersionRange) + +import Distribution.Client.Types.PackageLocation (UnresolvedSourcePackage) +import Distribution.Solver.Types.PackageIndex (PackageIndex) + +-- | This is the information we get from a @00-index.tar.gz@ hackage index. +-- +data SourcePackageDb = SourcePackageDb + { packageIndex :: PackageIndex UnresolvedSourcePackage + , packagePreferences :: Map PackageName VersionRange + } + deriving (Eq, Generic) + +instance Binary SourcePackageDb diff --git a/cabal-install/Distribution/Client/SourceRepo.hs b/cabal-install/Distribution/Client/Types/SourceRepo.hs similarity index 95% rename from cabal-install/Distribution/Client/SourceRepo.hs rename to cabal-install/Distribution/Client/Types/SourceRepo.hs index 15801f62420..6b0ff207687 100644 --- a/cabal-install/Distribution/Client/SourceRepo.hs +++ b/cabal-install/Distribution/Client/Types/SourceRepo.hs @@ -5,7 +5,16 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} -module Distribution.Client.SourceRepo where +module Distribution.Client.Types.SourceRepo ( + SourceRepositoryPackage (..), + SourceRepoList, + SourceRepoMaybe, + SourceRepoProxy, + srpHoist, + srpToProxy, + srpFanOut, + sourceRepositoryPackageGrammar, +) where import Distribution.Client.Compat.Prelude import Prelude () diff --git a/cabal-install/Distribution/Client/Types/WriteGhcEnvironmentFilesPolicy.hs b/cabal-install/Distribution/Client/Types/WriteGhcEnvironmentFilesPolicy.hs new file mode 100644 index 00000000000..b0563ca0c12 --- /dev/null +++ b/cabal-install/Distribution/Client/Types/WriteGhcEnvironmentFilesPolicy.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy ( + WriteGhcEnvironmentFilesPolicy (..), +) where + +import Prelude () +import Distribution.Client.Compat.Prelude + +-- | Whether 'v2-build' should write a .ghc.environment file after +-- success. Possible values: 'always', 'never' (the default), 'ghc8.4.4+' +-- (8.4.4 is the earliest version that supports +-- '-package-env -'). +data WriteGhcEnvironmentFilesPolicy + = AlwaysWriteGhcEnvironmentFiles + | NeverWriteGhcEnvironmentFiles + | WriteGhcEnvironmentFilesOnlyForGhc844AndNewer + deriving (Eq, Enum, Bounded, Generic, Show) + +instance Binary WriteGhcEnvironmentFilesPolicy +instance Structured WriteGhcEnvironmentFilesPolicy diff --git a/cabal-install/Distribution/Client/Upload.hs b/cabal-install/Distribution/Client/Upload.hs index 71c02f8c11d..9dda966f769 100644 --- a/cabal-install/Distribution/Client/Upload.hs +++ b/cabal-install/Distribution/Client/Upload.hs @@ -1,7 +1,8 @@ module Distribution.Client.Upload (upload, uploadDoc, report) where -import Distribution.Client.Types ( Username(..), Password(..) - , RemoteRepo(..), maybeRepoRemote, unRepoName ) +import Distribution.Client.Types.Credentials ( Username(..), Password(..) ) +import Distribution.Client.Types.Repo (RemoteRepo(..), maybeRepoRemote) +import Distribution.Client.Types.RepoName (unRepoName) import Distribution.Client.HttpUtils ( HttpTransport(..), remoteRepoTryUpgradeToHttps ) import Distribution.Client.Setup diff --git a/cabal-install/Distribution/Client/VCS.hs b/cabal-install/Distribution/Client/VCS.hs index 9d897d77c75..adb589881bb 100644 --- a/cabal-install/Distribution/Client/VCS.hs +++ b/cabal-install/Distribution/Client/VCS.hs @@ -35,7 +35,7 @@ import Distribution.Client.Compat.Prelude import Distribution.Types.SourceRepo ( RepoType(..) ) -import Distribution.Client.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..), srpToProxy) +import Distribution.Client.Types.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..), srpToProxy) import Distribution.Client.RebuildMonad ( Rebuild, monitorFiles, MonitorFilePath, monitorDirectoryExistence ) import Distribution.Verbosity as Verbosity diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index c938bff444c..9a5b431df39 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -243,13 +243,25 @@ executable cabal Distribution.Client.SetupWrapper Distribution.Client.SolverInstallPlan Distribution.Client.SourceFiles - Distribution.Client.SourceRepo Distribution.Client.SrcDist Distribution.Client.Store Distribution.Client.Tar Distribution.Client.TargetSelector Distribution.Client.Targets Distribution.Client.Types + Distribution.Client.Types.AllowNewer + Distribution.Client.Types.BuildResults + Distribution.Client.Types.Credentials + Distribution.Client.Types.ConfiguredId + Distribution.Client.Types.ConfiguredPackage + Distribution.Client.Types.PackageLocation + Distribution.Client.Types.PackageSpecifier + Distribution.Client.Types.ReadyPackage + Distribution.Client.Types.Repo + Distribution.Client.Types.RepoName + Distribution.Client.Types.SourcePackageDb + Distribution.Client.Types.SourceRepo + Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy Distribution.Client.Update Distribution.Client.Upload Distribution.Client.Utils diff --git a/cabal-install/cabal-install.cabal.pp b/cabal-install/cabal-install.cabal.pp index 51efecb74c0..4b070ddf711 100644 --- a/cabal-install/cabal-install.cabal.pp +++ b/cabal-install/cabal-install.cabal.pp @@ -182,13 +182,25 @@ Distribution.Client.SetupWrapper Distribution.Client.SolverInstallPlan Distribution.Client.SourceFiles - Distribution.Client.SourceRepo Distribution.Client.SrcDist Distribution.Client.Store Distribution.Client.Tar Distribution.Client.TargetSelector Distribution.Client.Targets Distribution.Client.Types + Distribution.Client.Types.AllowNewer + Distribution.Client.Types.BuildResults + Distribution.Client.Types.Credentials + Distribution.Client.Types.ConfiguredId + Distribution.Client.Types.ConfiguredPackage + Distribution.Client.Types.PackageLocation + Distribution.Client.Types.PackageSpecifier + Distribution.Client.Types.ReadyPackage + Distribution.Client.Types.Repo + Distribution.Client.Types.RepoName + Distribution.Client.Types.SourcePackageDb + Distribution.Client.Types.SourceRepo + Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy Distribution.Client.Update Distribution.Client.Upload Distribution.Client.Utils diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index e34c6d08798..96e9c6e1b64 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -136,7 +136,7 @@ import Distribution.Client.Sandbox.PackageEnvironment (setPackageDB) import Distribution.Client.Sandbox.Timestamp (maybeAddCompilerTimestampRecord) import Distribution.Client.Sandbox.Types (UseSandbox(..), whenUsingSandbox) import Distribution.Client.Tar (createTarGzFile) -import Distribution.Client.Types (Password (..)) +import Distribution.Client.Types.Credentials (Password (..)) import Distribution.Client.Init (initCabal) import Distribution.Client.Manpage (manpageCmd) import Distribution.Client.ManpageFlags (ManpageFlags (..)) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Get.hs b/cabal-install/tests/UnitTests/Distribution/Client/Get.hs index 7fa902740b9..7955dd66d27 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Get.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Get.hs @@ -6,7 +6,7 @@ import Distribution.Client.Get import Distribution.Types.PackageId import Distribution.Types.PackageName import Distribution.Types.SourceRepo (SourceRepo (..), emptySourceRepo, RepoKind (..), RepoType (..)) -import Distribution.Client.SourceRepo (SourceRepositoryPackage (..)) +import Distribution.Client.Types.SourceRepo (SourceRepositoryPackage (..)) import Distribution.Verbosity as Verbosity import Distribution.Version diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs index 384bad9a4f4..ea69806a751 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -32,7 +32,7 @@ import Distribution.Client.Types import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.Dependency.Types import Distribution.Client.Targets -import Distribution.Client.SourceRepo +import Distribution.Client.Types.SourceRepo import Distribution.Utils.NubList import Distribution.Solver.Types.PackageConstraint diff --git a/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs index fcc874d1101..b3136fffd1d 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs @@ -35,7 +35,7 @@ import Distribution.Client.IndexUtils.Timestamp import Distribution.Client.InstallSymlink import Distribution.Client.ProjectConfig.Types import Distribution.Client.Targets -import Distribution.Client.SourceRepo (SourceRepositoryPackage) +import Distribution.Client.Types.SourceRepo (SourceRepositoryPackage) import Distribution.Client.Types import UnitTests.Distribution.Client.GenericInstances () diff --git a/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs b/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs index 0808865f468..3c682a532bf 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/VCS.hs @@ -7,7 +7,7 @@ import Distribution.Client.RebuildMonad ( execRebuild ) import Distribution.Simple.Program import Distribution.Verbosity as Verbosity -import Distribution.Client.SourceRepo (SourceRepositoryPackage (..), SourceRepoProxy) +import Distribution.Client.Types.SourceRepo (SourceRepositoryPackage (..), SourceRepoProxy) import Data.List import Data.Tuple