1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric      #-}
3{-# LANGUAGE TypeFamilies       #-}
4{-# LANGUAGE OverloadedStrings  #-}
5module Distribution.Types.InstalledPackageInfo (
6    InstalledPackageInfo (..),
7    emptyInstalledPackageInfo,
8    mungedPackageId,
9    mungedPackageName,
10    AbiDependency (..),
11    ExposedModule (..),
12    ) where
13
14import Distribution.Compat.Prelude
15import Prelude ()
16
17import Distribution.Backpack
18import Distribution.Compat.Graph            (IsNode (..))
19import Distribution.License
20import Distribution.ModuleName
21import Distribution.Package                 hiding (installedUnitId)
22import Distribution.Types.AbiDependency
23import Distribution.Types.ExposedModule
24import Distribution.Types.LibraryName
25import Distribution.Types.LibraryVisibility
26import Distribution.Types.MungedPackageId
27import Distribution.Types.MungedPackageName
28import Distribution.Version                 (nullVersion)
29import Distribution.Utils.ShortText         (ShortText)
30
31import qualified Distribution.Package as Package
32import qualified Distribution.SPDX    as SPDX
33
34-- -----------------------------------------------------------------------------
35-- The InstalledPackageInfo type
36
37-- For BC reasons, we continue to name this record an InstalledPackageInfo;
38-- but it would more accurately be called an InstalledUnitInfo with Backpack
39data InstalledPackageInfo
40   = InstalledPackageInfo {
41        -- these parts (sourcePackageId, installedUnitId) are
42        -- exactly the same as PackageDescription
43        sourcePackageId   :: PackageId,
44        sourceLibName     :: LibraryName,
45        installedComponentId_ :: ComponentId,
46        libVisibility     :: LibraryVisibility,
47        installedUnitId   :: UnitId,
48        -- INVARIANT: if this package is definite, OpenModule's
49        -- OpenUnitId directly records UnitId.  If it is
50        -- indefinite, OpenModule is always an OpenModuleVar
51        -- with the same ModuleName as the key.
52        instantiatedWith  :: [(ModuleName, OpenModule)],
53        compatPackageKey  :: String,
54        license           :: Either SPDX.License License,
55        copyright         :: !ShortText,
56        maintainer        :: !ShortText,
57        author            :: !ShortText,
58        stability         :: !ShortText,
59        homepage          :: !ShortText,
60        pkgUrl            :: !ShortText,
61        synopsis          :: !ShortText,
62        description       :: !ShortText,
63        category          :: !ShortText,
64        -- these parts are required by an installed package only:
65        abiHash           :: AbiHash,
66        indefinite        :: Bool,
67        exposed           :: Bool,
68        -- INVARIANT: if the package is definite, OpenModule's
69        -- OpenUnitId directly records UnitId.
70        exposedModules    :: [ExposedModule],
71        hiddenModules     :: [ModuleName],
72        trusted           :: Bool,
73        importDirs        :: [FilePath],
74        libraryDirs       :: [FilePath],
75        libraryDynDirs    :: [FilePath],  -- ^ overrides 'libraryDirs'
76        dataDir           :: FilePath,
77        hsLibraries       :: [String],
78        extraLibraries    :: [String],
79        extraGHCiLibraries:: [String],    -- overrides extraLibraries for GHCi
80        includeDirs       :: [FilePath],
81        includes          :: [String],
82        -- INVARIANT: if the package is definite, UnitId is NOT
83        -- a ComponentId of an indefinite package
84        depends           :: [UnitId],
85        abiDepends        :: [AbiDependency],
86        ccOptions         :: [String],
87        cxxOptions        :: [String],
88        ldOptions         :: [String],
89        frameworkDirs     :: [FilePath],
90        frameworks        :: [String],
91        haddockInterfaces :: [FilePath],
92        haddockHTMLs      :: [FilePath],
93        pkgRoot           :: Maybe FilePath
94    }
95    deriving (Eq, Generic, Typeable, Read, Show)
96
97instance Binary InstalledPackageInfo
98instance Structured InstalledPackageInfo
99
100instance NFData InstalledPackageInfo where rnf = genericRnf
101
102instance Package.HasMungedPackageId InstalledPackageInfo where
103   mungedId = mungedPackageId
104
105instance Package.Package InstalledPackageInfo where
106   packageId = sourcePackageId
107
108instance Package.HasUnitId InstalledPackageInfo where
109   installedUnitId = installedUnitId
110
111instance Package.PackageInstalled InstalledPackageInfo where
112   installedDepends = depends
113
114instance IsNode InstalledPackageInfo where
115    type Key InstalledPackageInfo = UnitId
116    nodeKey       = installedUnitId
117    nodeNeighbors = depends
118
119mungedPackageId :: InstalledPackageInfo -> MungedPackageId
120mungedPackageId ipi =
121    MungedPackageId (mungedPackageName ipi) (packageVersion ipi)
122
123-- | Returns the munged package name, which we write into @name@ for
124-- compatibility with old versions of GHC.
125mungedPackageName :: InstalledPackageInfo -> MungedPackageName
126mungedPackageName ipi = MungedPackageName (packageName ipi) (sourceLibName ipi)
127
128emptyInstalledPackageInfo :: InstalledPackageInfo
129emptyInstalledPackageInfo
130   = InstalledPackageInfo {
131        sourcePackageId   = PackageIdentifier (mkPackageName "") nullVersion,
132        sourceLibName     = LMainLibName,
133        installedComponentId_ = mkComponentId "",
134        installedUnitId   = mkUnitId "",
135        instantiatedWith  = [],
136        compatPackageKey  = "",
137        license           = Left SPDX.NONE,
138        copyright         = "",
139        maintainer        = "",
140        author            = "",
141        stability         = "",
142        homepage          = "",
143        pkgUrl            = "",
144        synopsis          = "",
145        description       = "",
146        category          = "",
147        abiHash           = mkAbiHash "",
148        indefinite        = False,
149        exposed           = False,
150        exposedModules    = [],
151        hiddenModules     = [],
152        trusted           = False,
153        importDirs        = [],
154        libraryDirs       = [],
155        libraryDynDirs    = [],
156        dataDir           = "",
157        hsLibraries       = [],
158        extraLibraries    = [],
159        extraGHCiLibraries= [],
160        includeDirs       = [],
161        includes          = [],
162        depends           = [],
163        abiDepends        = [],
164        ccOptions         = [],
165        cxxOptions        = [],
166        ldOptions         = [],
167        frameworkDirs     = [],
168        frameworks        = [],
169        haddockInterfaces = [],
170        haddockHTMLs      = [],
171        pkgRoot           = Nothing,
172        libVisibility     = LibraryVisibilityPrivate
173    }
174