Unverified Commit 5392ac8c authored by Oleg Grenrus's avatar Oleg Grenrus Committed by GitHub
Browse files

Merge pull request #6599 from phadej/split-client-types

Split D.Client.Types module
parents 03f211cc 108f6c1e
......@@ -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
......
......@@ -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(..) )
......
......@@ -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 Distribution.Compat.CharParsing as P
import qualified Data.Map.Strict as Map
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp
-------------------------------------------------------------------------------
......
......@@ -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 )
......
......@@ -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 )
......
......@@ -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 )
......
......@@ -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
......
......@@ -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
......
......@@ -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.