{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}

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

type ReadyPackage = GenericReadyPackage (ConfiguredPackage UnresolvedPkgLoc)