{-# 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 (GenericReadyPackage srcpkg -> GenericReadyPackage srcpkg -> Bool
forall srcpkg.
Eq srcpkg =>
GenericReadyPackage srcpkg -> GenericReadyPackage srcpkg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericReadyPackage srcpkg -> GenericReadyPackage srcpkg -> Bool
$c/= :: forall srcpkg.
Eq srcpkg =>
GenericReadyPackage srcpkg -> GenericReadyPackage srcpkg -> Bool
== :: GenericReadyPackage srcpkg -> GenericReadyPackage srcpkg -> Bool
$c== :: forall srcpkg.
Eq srcpkg =>
GenericReadyPackage srcpkg -> GenericReadyPackage srcpkg -> Bool
Eq, Int -> GenericReadyPackage srcpkg -> ShowS
forall srcpkg.
Show srcpkg =>
Int -> GenericReadyPackage srcpkg -> ShowS
forall srcpkg. Show srcpkg => [GenericReadyPackage srcpkg] -> ShowS
forall srcpkg. Show srcpkg => GenericReadyPackage srcpkg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericReadyPackage srcpkg] -> ShowS
$cshowList :: forall srcpkg. Show srcpkg => [GenericReadyPackage srcpkg] -> ShowS
show :: GenericReadyPackage srcpkg -> String
$cshow :: forall srcpkg. Show srcpkg => GenericReadyPackage srcpkg -> String
showsPrec :: Int -> GenericReadyPackage srcpkg -> ShowS
$cshowsPrec :: forall srcpkg.
Show srcpkg =>
Int -> GenericReadyPackage srcpkg -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcpkg x.
Rep (GenericReadyPackage srcpkg) x -> GenericReadyPackage srcpkg
forall srcpkg x.
GenericReadyPackage srcpkg -> Rep (GenericReadyPackage srcpkg) x
$cto :: forall srcpkg x.
Rep (GenericReadyPackage srcpkg) x -> GenericReadyPackage srcpkg
$cfrom :: forall srcpkg x.
GenericReadyPackage srcpkg -> Rep (GenericReadyPackage srcpkg) x
Generic, GenericReadyPackage srcpkg -> PackageIdentifier
forall srcpkg.
Package srcpkg =>
GenericReadyPackage srcpkg -> PackageIdentifier
forall pkg. (pkg -> PackageIdentifier) -> Package pkg
packageId :: GenericReadyPackage srcpkg -> PackageIdentifier
$cpackageId :: forall srcpkg.
Package srcpkg =>
GenericReadyPackage srcpkg -> PackageIdentifier
Package, GenericReadyPackage srcpkg -> ComponentDeps [UnitId]
forall pkg.
Package pkg
-> (pkg -> ComponentDeps [UnitId]) -> PackageFixedDeps pkg
forall {srcpkg}.
PackageFixedDeps srcpkg =>
Package (GenericReadyPackage srcpkg)
forall srcpkg.
PackageFixedDeps srcpkg =>
GenericReadyPackage srcpkg -> ComponentDeps [UnitId]
depends :: GenericReadyPackage srcpkg -> ComponentDeps [UnitId]
$cdepends :: forall srcpkg.
PackageFixedDeps srcpkg =>
GenericReadyPackage srcpkg -> ComponentDeps [UnitId]
PackageFixedDeps,
            GenericReadyPackage srcpkg -> MungedPackageId
forall srcpkg.
HasMungedPackageId srcpkg =>
GenericReadyPackage srcpkg -> MungedPackageId
forall pkg. (pkg -> MungedPackageId) -> HasMungedPackageId pkg
mungedId :: GenericReadyPackage srcpkg -> MungedPackageId
$cmungedId :: forall srcpkg.
HasMungedPackageId srcpkg =>
GenericReadyPackage srcpkg -> MungedPackageId
HasMungedPackageId, GenericReadyPackage srcpkg -> UnitId
forall {srcpkg}.
HasUnitId srcpkg =>
Package (GenericReadyPackage srcpkg)
forall srcpkg.
HasUnitId srcpkg =>
GenericReadyPackage srcpkg -> UnitId
forall pkg. Package pkg -> (pkg -> UnitId) -> HasUnitId pkg
installedUnitId :: GenericReadyPackage srcpkg -> UnitId
$cinstalledUnitId :: forall srcpkg.
HasUnitId srcpkg =>
GenericReadyPackage srcpkg -> UnitId
HasUnitId, GenericReadyPackage srcpkg -> [UnitId]
forall pkg.
HasUnitId pkg -> (pkg -> [UnitId]) -> PackageInstalled pkg
forall {srcpkg}.
PackageInstalled srcpkg =>
HasUnitId (GenericReadyPackage srcpkg)
forall srcpkg.
PackageInstalled srcpkg =>
GenericReadyPackage srcpkg -> [UnitId]
installedDepends :: GenericReadyPackage srcpkg -> [UnitId]
$cinstalledDepends :: forall srcpkg.
PackageInstalled srcpkg =>
GenericReadyPackage srcpkg -> [UnitId]
PackageInstalled, Get (GenericReadyPackage srcpkg)
[GenericReadyPackage srcpkg] -> Put
GenericReadyPackage srcpkg -> Put
forall srcpkg. Binary srcpkg => Get (GenericReadyPackage srcpkg)
forall srcpkg. Binary srcpkg => [GenericReadyPackage srcpkg] -> Put
forall srcpkg. Binary srcpkg => GenericReadyPackage srcpkg -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GenericReadyPackage srcpkg] -> Put
$cputList :: forall srcpkg. Binary srcpkg => [GenericReadyPackage srcpkg] -> Put
get :: Get (GenericReadyPackage srcpkg)
$cget :: forall srcpkg. Binary srcpkg => Get (GenericReadyPackage srcpkg)
put :: GenericReadyPackage srcpkg -> Put
$cput :: forall srcpkg. Binary srcpkg => GenericReadyPackage srcpkg -> Put
Binary)

-- Can't newtype derive this
instance IsNode srcpkg => IsNode (GenericReadyPackage srcpkg) where
    type Key (GenericReadyPackage srcpkg) = Key srcpkg
    nodeKey :: GenericReadyPackage srcpkg -> Key (GenericReadyPackage srcpkg)
nodeKey (ReadyPackage srcpkg
spkg) = forall a. IsNode a => a -> Key a
nodeKey srcpkg
spkg
    nodeNeighbors :: GenericReadyPackage srcpkg -> [Key (GenericReadyPackage srcpkg)]
nodeNeighbors (ReadyPackage srcpkg
spkg) = forall a. IsNode a => a -> [Key a]
nodeNeighbors srcpkg
spkg

type ReadyPackage = GenericReadyPackage (ConfiguredPackage UnresolvedPkgLoc)