Commit 108f6c1e authored by Oleg Grenrus's avatar Oleg Grenrus

Split D.Client.Types module

parent eba38fc8
......@@ -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 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
-------------------------------------------------------------------------------
......
......@@ -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
......
This diff is collapsed.
{-# 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 = (<>)
{-# 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
{-# 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)
{-# 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
module Distribution.Client.Types.Credentials (
Username (..),
Password (..),
) where
newtype Username = Username { unUsername :: String }
newtype Password = Password { unPassword :: String }
{-# 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'.