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

module Distribution.Types.ComponentLocalBuildInfo (
  ComponentLocalBuildInfo(..),
  componentIsIndefinite,
  maybeComponentInstantiatedWith,
  ) where

import Prelude ()
import Distribution.Compat.Prelude
import Distribution.ModuleName

import Distribution.Backpack
import Distribution.Compat.Graph
import Distribution.Types.ComponentId
import Distribution.Types.MungedPackageId
import Distribution.Types.UnitId
import Distribution.Types.ComponentName
import Distribution.Types.MungedPackageName

import Distribution.PackageDescription
import qualified Distribution.InstalledPackageInfo as Installed

-- | The first five fields are common across all algebraic variants.
data ComponentLocalBuildInfo
  = LibComponentLocalBuildInfo {
    -- | It would be very convenient to store the literal Library here,
    -- but if we do that, it will get serialized (via the Binary)
    -- instance twice.  So instead we just provide the ComponentName,
    -- which can be used to find the Component in the
    -- PackageDescription.  NB: eventually, this will NOT uniquely
    -- identify the ComponentLocalBuildInfo.
    ComponentLocalBuildInfo -> ComponentName
componentLocalName :: ComponentName,
    -- | The computed 'ComponentId' of this component.
    ComponentLocalBuildInfo -> ComponentId
componentComponentId :: ComponentId,
    -- | The computed 'UnitId' which uniquely identifies this
    -- component.  Might be hashed.
    ComponentLocalBuildInfo -> UnitId
componentUnitId :: UnitId,
    -- | Is this an indefinite component (i.e. has unfilled holes)?
    ComponentLocalBuildInfo -> Bool
componentIsIndefinite_ :: Bool,
    -- | How the component was instantiated
    ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith :: [(ModuleName, OpenModule)],
    -- | Resolved internal and external package dependencies for this component.
    -- The 'BuildInfo' specifies a set of build dependencies that must be
    -- satisfied in terms of version ranges. This field fixes those dependencies
    -- to the specific versions available on this machine for this compiler.
    ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps :: [(UnitId, MungedPackageId)],
    -- | The set of packages that are brought into scope during
    -- compilation, including a 'ModuleRenaming' which may used
    -- to hide or rename modules.  This is what gets translated into
    -- @-package-id@ arguments.  This is a modernized version of
    -- 'componentPackageDeps', which is kept around for BC purposes.
    ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
componentIncludes :: [(OpenUnitId, ModuleRenaming)],
    ComponentLocalBuildInfo -> [UnitId]
componentExeDeps :: [UnitId],
    -- | The internal dependencies which induce a graph on the
    -- 'ComponentLocalBuildInfo' of this package.  This does NOT
    -- coincide with 'componentPackageDeps' because it ALSO records
    -- 'build-tool' dependencies on executables.  Maybe one day
    -- @cabal-install@ will also handle these correctly too!
    ComponentLocalBuildInfo -> [UnitId]
componentInternalDeps :: [UnitId],
    -- | Compatibility "package key" that we pass to older versions of GHC.
    ComponentLocalBuildInfo -> String
componentCompatPackageKey :: String,
    -- | Compatibility "package name" that we register this component as.
    ComponentLocalBuildInfo -> MungedPackageName
componentCompatPackageName :: MungedPackageName,
    -- | A list of exposed modules (either defined in this component,
    -- or reexported from another component.)
    ComponentLocalBuildInfo -> [ExposedModule]
componentExposedModules :: [Installed.ExposedModule],
    -- | Convenience field, specifying whether or not this is the
    -- "public library" that has the same name as the package.
    ComponentLocalBuildInfo -> Bool
componentIsPublic :: Bool
  }
  -- TODO: refactor all these duplicates
  | FLibComponentLocalBuildInfo {
    componentLocalName :: ComponentName,
    componentComponentId :: ComponentId,
    componentUnitId :: UnitId,
    componentPackageDeps :: [(UnitId, MungedPackageId)],
    componentIncludes :: [(OpenUnitId, ModuleRenaming)],
    componentExeDeps :: [UnitId],
    componentInternalDeps :: [UnitId]
  }
  | ExeComponentLocalBuildInfo {
    componentLocalName :: ComponentName,
    componentComponentId :: ComponentId,
    componentUnitId :: UnitId,
    componentPackageDeps :: [(UnitId, MungedPackageId)],
    componentIncludes :: [(OpenUnitId, ModuleRenaming)],
    componentExeDeps :: [UnitId],
    componentInternalDeps :: [UnitId]
  }
  | TestComponentLocalBuildInfo {
    componentLocalName :: ComponentName,
    componentComponentId :: ComponentId,
    componentUnitId :: UnitId,
    componentPackageDeps :: [(UnitId, MungedPackageId)],
    componentIncludes :: [(OpenUnitId, ModuleRenaming)],
    componentExeDeps :: [UnitId],
    componentInternalDeps :: [UnitId]

  }
  | BenchComponentLocalBuildInfo {
    componentLocalName :: ComponentName,
    componentComponentId :: ComponentId,
    componentUnitId :: UnitId,
    componentPackageDeps :: [(UnitId, MungedPackageId)],
    componentIncludes :: [(OpenUnitId, ModuleRenaming)],
    componentExeDeps :: [UnitId],
    componentInternalDeps :: [UnitId]
  }
  deriving ((forall x.
 ComponentLocalBuildInfo -> Rep ComponentLocalBuildInfo x)
-> (forall x.
    Rep ComponentLocalBuildInfo x -> ComponentLocalBuildInfo)
-> Generic ComponentLocalBuildInfo
forall x. Rep ComponentLocalBuildInfo x -> ComponentLocalBuildInfo
forall x. ComponentLocalBuildInfo -> Rep ComponentLocalBuildInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComponentLocalBuildInfo x -> ComponentLocalBuildInfo
$cfrom :: forall x. ComponentLocalBuildInfo -> Rep ComponentLocalBuildInfo x
Generic, ReadPrec [ComponentLocalBuildInfo]
ReadPrec ComponentLocalBuildInfo
Int -> ReadS ComponentLocalBuildInfo
ReadS [ComponentLocalBuildInfo]
(Int -> ReadS ComponentLocalBuildInfo)
-> ReadS [ComponentLocalBuildInfo]
-> ReadPrec ComponentLocalBuildInfo
-> ReadPrec [ComponentLocalBuildInfo]
-> Read ComponentLocalBuildInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ComponentLocalBuildInfo]
$creadListPrec :: ReadPrec [ComponentLocalBuildInfo]
readPrec :: ReadPrec ComponentLocalBuildInfo
$creadPrec :: ReadPrec ComponentLocalBuildInfo
readList :: ReadS [ComponentLocalBuildInfo]
$creadList :: ReadS [ComponentLocalBuildInfo]
readsPrec :: Int -> ReadS ComponentLocalBuildInfo
$creadsPrec :: Int -> ReadS ComponentLocalBuildInfo
External instance of the constraint type Read ExposedModule
External instance of the constraint type Read Char
External instance of the constraint type Read ModuleRenaming
External instance of the constraint type Read OpenUnitId
External instance of the constraint type Read ModuleRenaming
External instance of the constraint type Read OpenUnitId
External instance of the constraint type Read MungedPackageId
External instance of the constraint type Read MungedPackageId
External instance of the constraint type Read OpenModule
External instance of the constraint type Read ModuleName
External instance of the constraint type Read OpenModule
External instance of the constraint type Read ModuleName
External instance of the constraint type forall a b. (Read a, Read b) => Read (a, b)
External instance of the constraint type Read ExposedModule
External instance of the constraint type Read MungedPackageName
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read UnitId
External instance of the constraint type forall a b. (Read a, Read b) => Read (a, b)
External instance of the constraint type Read OpenUnitId
External instance of the constraint type Read ModuleRenaming
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type forall a b. (Read a, Read b) => Read (a, b)
External instance of the constraint type Read OpenUnitId
External instance of the constraint type Read ModuleRenaming
External instance of the constraint type forall a b. (Read a, Read b) => Read (a, b)
External instance of the constraint type Read UnitId
External instance of the constraint type Read MungedPackageId
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type forall a b. (Read a, Read b) => Read (a, b)
External instance of the constraint type Read UnitId
External instance of the constraint type Read MungedPackageId
External instance of the constraint type forall a b. (Read a, Read b) => Read (a, b)
External instance of the constraint type Read ModuleName
External instance of the constraint type Read OpenModule
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Bool
External instance of the constraint type Read Bool
External instance of the constraint type Read UnitId
External instance of the constraint type Read UnitId
External instance of the constraint type Read ComponentId
External instance of the constraint type Read ComponentId
External instance of the constraint type Read ComponentName
External instance of the constraint type Read ComponentName
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read ComponentLocalBuildInfo
Read, Int -> ComponentLocalBuildInfo -> ShowS
[ComponentLocalBuildInfo] -> ShowS
ComponentLocalBuildInfo -> String
(Int -> ComponentLocalBuildInfo -> ShowS)
-> (ComponentLocalBuildInfo -> String)
-> ([ComponentLocalBuildInfo] -> ShowS)
-> Show ComponentLocalBuildInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentLocalBuildInfo] -> ShowS
$cshowList :: [ComponentLocalBuildInfo] -> ShowS
show :: ComponentLocalBuildInfo -> String
$cshow :: ComponentLocalBuildInfo -> String
showsPrec :: Int -> ComponentLocalBuildInfo -> ShowS
$cshowsPrec :: Int -> ComponentLocalBuildInfo -> ShowS
External instance of the constraint type Show ExposedModule
External instance of the constraint type Show Char
External instance of the constraint type Show ModuleRenaming
External instance of the constraint type Show OpenUnitId
External instance of the constraint type Show ModuleRenaming
External instance of the constraint type Show OpenUnitId
External instance of the constraint type Show MungedPackageId
External instance of the constraint type Show MungedPackageId
External instance of the constraint type Show OpenModule
External instance of the constraint type Show ModuleName
External instance of the constraint type Show OpenModule
External instance of the constraint type Show ModuleName
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type Show ExposedModule
External instance of the constraint type Show MungedPackageName
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show UnitId
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type Show OpenUnitId
External instance of the constraint type Show ModuleRenaming
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type Show OpenUnitId
External instance of the constraint type Show ModuleRenaming
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type Show UnitId
External instance of the constraint type Show MungedPackageId
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type Show UnitId
External instance of the constraint type Show MungedPackageId
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type Show ModuleName
External instance of the constraint type Show OpenModule
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Bool
External instance of the constraint type Show Bool
External instance of the constraint type Show UnitId
External instance of the constraint type Show UnitId
External instance of the constraint type Show ComponentId
External instance of the constraint type Show ComponentId
External instance of the constraint type Show ComponentName
External instance of the constraint type Show ComponentName
External instance of the constraint type Ord Int
External instance of the constraint type Ord Int
Show, Typeable)

instance Binary ComponentLocalBuildInfo
instance Structured ComponentLocalBuildInfo

instance IsNode ComponentLocalBuildInfo where
    type Key ComponentLocalBuildInfo = UnitId
    nodeKey :: ComponentLocalBuildInfo -> Key ComponentLocalBuildInfo
nodeKey = ComponentLocalBuildInfo -> Key ComponentLocalBuildInfo
ComponentLocalBuildInfo -> UnitId
componentUnitId
    nodeNeighbors :: ComponentLocalBuildInfo -> [Key ComponentLocalBuildInfo]
nodeNeighbors = ComponentLocalBuildInfo -> [Key ComponentLocalBuildInfo]
ComponentLocalBuildInfo -> [UnitId]
componentInternalDeps

componentIsIndefinite :: ComponentLocalBuildInfo -> Bool
componentIsIndefinite :: ComponentLocalBuildInfo -> Bool
componentIsIndefinite LibComponentLocalBuildInfo{ componentIsIndefinite_ :: ComponentLocalBuildInfo -> Bool
componentIsIndefinite_ = Bool
b } = Bool
b
componentIsIndefinite ComponentLocalBuildInfo
_ = Bool
False

maybeComponentInstantiatedWith :: ComponentLocalBuildInfo -> Maybe [(ModuleName, OpenModule)]
maybeComponentInstantiatedWith :: ComponentLocalBuildInfo -> Maybe [(ModuleName, OpenModule)]
maybeComponentInstantiatedWith
    LibComponentLocalBuildInfo { componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts } = [(ModuleName, OpenModule)] -> Maybe [(ModuleName, OpenModule)]
forall a. a -> Maybe a
Just [(ModuleName, OpenModule)]
insts
maybeComponentInstantiatedWith ComponentLocalBuildInfo
_ = Maybe [(ModuleName, OpenModule)]
forall a. Maybe a
Nothing