{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

module Distribution.Types.GivenComponent
  ( GivenComponent (..)
  , PromisedComponent (..)
  ) where

import Distribution.Compat.Prelude

import Distribution.Types.ComponentId
import Distribution.Types.LibraryName
import Distribution.Types.PackageId
import Distribution.Types.PackageName

-- | A 'GivenComponent' represents a library depended on and explicitly
-- specified by the user/client with @--dependency@
--
-- It enables Cabal to know which 'ComponentId' to associate with a library
--
-- @since 2.3.0.0
data GivenComponent = GivenComponent
  { GivenComponent -> PackageName
givenComponentPackage :: PackageName
  , GivenComponent -> LibraryName
givenComponentName :: LibraryName -- --dependency is for libraries
  -- only, not for any component
  , GivenComponent -> ComponentId
givenComponentId :: ComponentId
  }
  deriving ((forall x. GivenComponent -> Rep GivenComponent x)
-> (forall x. Rep GivenComponent x -> GivenComponent)
-> Generic GivenComponent
forall x. Rep GivenComponent x -> GivenComponent
forall x. GivenComponent -> Rep GivenComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GivenComponent -> Rep GivenComponent x
from :: forall x. GivenComponent -> Rep GivenComponent x
$cto :: forall x. Rep GivenComponent x -> GivenComponent
to :: forall x. Rep GivenComponent x -> GivenComponent
Generic, ReadPrec [GivenComponent]
ReadPrec GivenComponent
Int -> ReadS GivenComponent
ReadS [GivenComponent]
(Int -> ReadS GivenComponent)
-> ReadS [GivenComponent]
-> ReadPrec GivenComponent
-> ReadPrec [GivenComponent]
-> Read GivenComponent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GivenComponent
readsPrec :: Int -> ReadS GivenComponent
$creadList :: ReadS [GivenComponent]
readList :: ReadS [GivenComponent]
$creadPrec :: ReadPrec GivenComponent
readPrec :: ReadPrec GivenComponent
$creadListPrec :: ReadPrec [GivenComponent]
readListPrec :: ReadPrec [GivenComponent]
Read, Int -> GivenComponent -> ShowS
[GivenComponent] -> ShowS
GivenComponent -> String
(Int -> GivenComponent -> ShowS)
-> (GivenComponent -> String)
-> ([GivenComponent] -> ShowS)
-> Show GivenComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GivenComponent -> ShowS
showsPrec :: Int -> GivenComponent -> ShowS
$cshow :: GivenComponent -> String
show :: GivenComponent -> String
$cshowList :: [GivenComponent] -> ShowS
showList :: [GivenComponent] -> ShowS
Show, GivenComponent -> GivenComponent -> Bool
(GivenComponent -> GivenComponent -> Bool)
-> (GivenComponent -> GivenComponent -> Bool) -> Eq GivenComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GivenComponent -> GivenComponent -> Bool
== :: GivenComponent -> GivenComponent -> Bool
$c/= :: GivenComponent -> GivenComponent -> Bool
/= :: GivenComponent -> GivenComponent -> Bool
Eq, Typeable)

instance Binary GivenComponent
instance Structured GivenComponent

-- | A 'PromisedComponent' represents a promised library depended on and explicitly
-- specified by the user/client with @--promised-dependency@
--
-- It enables Cabal to know which 'ComponentId' to associate with a library
--
-- @since 3.14.0.0
data PromisedComponent = PromisedComponent
  { PromisedComponent -> PackageId
promisedComponentPackage :: PackageId
  , PromisedComponent -> LibraryName
promisedComponentName :: LibraryName -- --dependency is for libraries
  -- only, not for any component
  , PromisedComponent -> ComponentId
promisedComponentId :: ComponentId
  }
  deriving ((forall x. PromisedComponent -> Rep PromisedComponent x)
-> (forall x. Rep PromisedComponent x -> PromisedComponent)
-> Generic PromisedComponent
forall x. Rep PromisedComponent x -> PromisedComponent
forall x. PromisedComponent -> Rep PromisedComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PromisedComponent -> Rep PromisedComponent x
from :: forall x. PromisedComponent -> Rep PromisedComponent x
$cto :: forall x. Rep PromisedComponent x -> PromisedComponent
to :: forall x. Rep PromisedComponent x -> PromisedComponent
Generic, ReadPrec [PromisedComponent]
ReadPrec PromisedComponent
Int -> ReadS PromisedComponent
ReadS [PromisedComponent]
(Int -> ReadS PromisedComponent)
-> ReadS [PromisedComponent]
-> ReadPrec PromisedComponent
-> ReadPrec [PromisedComponent]
-> Read PromisedComponent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PromisedComponent
readsPrec :: Int -> ReadS PromisedComponent
$creadList :: ReadS [PromisedComponent]
readList :: ReadS [PromisedComponent]
$creadPrec :: ReadPrec PromisedComponent
readPrec :: ReadPrec PromisedComponent
$creadListPrec :: ReadPrec [PromisedComponent]
readListPrec :: ReadPrec [PromisedComponent]
Read, Int -> PromisedComponent -> ShowS
[PromisedComponent] -> ShowS
PromisedComponent -> String
(Int -> PromisedComponent -> ShowS)
-> (PromisedComponent -> String)
-> ([PromisedComponent] -> ShowS)
-> Show PromisedComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PromisedComponent -> ShowS
showsPrec :: Int -> PromisedComponent -> ShowS
$cshow :: PromisedComponent -> String
show :: PromisedComponent -> String
$cshowList :: [PromisedComponent] -> ShowS
showList :: [PromisedComponent] -> ShowS
Show, PromisedComponent -> PromisedComponent -> Bool
(PromisedComponent -> PromisedComponent -> Bool)
-> (PromisedComponent -> PromisedComponent -> Bool)
-> Eq PromisedComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PromisedComponent -> PromisedComponent -> Bool
== :: PromisedComponent -> PromisedComponent -> Bool
$c/= :: PromisedComponent -> PromisedComponent -> Bool
/= :: PromisedComponent -> PromisedComponent -> Bool
Eq, Typeable)

instance Binary PromisedComponent
instance Structured PromisedComponent