Cabal/Distribution/InstalledPackageInfo.hs

   1 {-# LANGUAGE DeriveGeneric #-}
   2 {-# LANGUAGE DeriveDataTypeable #-}
   3 {-# LANGUAGE TypeFamilies #-}
   4
   5 -----------------------------------------------------------------------------
   6 -- |
   7 -- Module      :  Distribution.InstalledPackageInfo
   8 -- Copyright   :  (c) The University of Glasgow 2004
   9 --
  10 -- Maintainer  :  libraries@haskell.org
  11 -- Portability :  portable
  12 --
  13 -- This is the information about an /installed/ package that
  14 -- is communicated to the @ghc-pkg@ program in order to register
  15 -- a package.  @ghc-pkg@ now consumes this package format (as of version
  16 -- 6.4). This is specific to GHC at the moment.
  17 --
  18 -- The @.cabal@ file format is for describing a package that is not yet
  19 -- installed. It has a lot of flexibility, like conditionals and dependency
  20 -- ranges. As such, that format is not at all suitable for describing a package
  21 -- that has already been built and installed. By the time we get to that stage,
  22 -- we have resolved all conditionals and resolved dependency version
  23 -- constraints to exact versions of dependent packages. So, this module defines
  24 -- the 'InstalledPackageInfo' data structure that contains all the info we keep
  25 -- about an installed package. There is a parser and pretty printer. The
  26 -- textual format is rather simpler than the @.cabal@ format: there are no
  27 -- sections, for example.
  28
  29 -- This module is meant to be local-only to Distribution...
  30
  31 module Distribution.InstalledPackageInfo (
  32         InstalledPackageInfo(..),
  33         installedPackageId,
  34         installedComponentId,
  35         requiredSignatures,
  36         installedOpenUnitId,
  37         ExposedModule(..),
  38         AbiDependency(..),
  39         ParseResult(..), PError(..), PWarning,
  40         emptyInstalledPackageInfo,
  41         parseInstalledPackageInfo,
  42         showInstalledPackageInfo,
  43         showInstalledPackageInfoField,
  44         showSimpleInstalledPackageInfoField,
  45         fieldsInstalledPackageInfo,
  46   ) where
  47
  48 import Prelude ()
  49 import Distribution.Compat.Prelude
  50
  51 import Distribution.ParseUtils
  52 import Distribution.License
  53 import Distribution.Package hiding (installedUnitId, installedPackageId)
  54 import Distribution.Backpack
  55 import qualified Distribution.Package as Package
  56 import Distribution.ModuleName
  57 import Distribution.Version
  58 import Distribution.Text
  59 import qualified Distribution.Compat.ReadP as Parse
  60 import Distribution.Compat.Graph
  61
  62 import Text.PrettyPrint as Disp
  63 import qualified Data.Char as Char
  64 import qualified Data.Map as Map
  65 import Data.Set (Set)
  66
  67 -- -----------------------------------------------------------------------------
  68 -- The InstalledPackageInfo type
  69
  70 -- For BC reasons, we continue to name this record an InstalledPackageInfo;
  71 -- but it would more accurately be called an InstalledUnitInfo with Backpack
  72 data InstalledPackageInfo
  73    = InstalledPackageInfo {
  74         -- these parts are exactly the same as PackageDescription
  75         sourcePackageId   :: PackageId,
  76         installedUnitId   :: UnitId,
  77         installedComponentId_ :: ComponentId,
  78         -- INVARIANT: if this package is definite, OpenModule's
  79         -- OpenUnitId directly records UnitId.  If it is
  80         -- indefinite, OpenModule is always an OpenModuleVar
  81         -- with the same ModuleName as the key.
  82         instantiatedWith  :: [(ModuleName, OpenModule)],
  83         compatPackageKey  :: String,
  84         license           :: License,
  85         copyright         :: String,
  86         maintainer        :: String,
  87         author            :: String,
  88         stability         :: String,
  89         homepage          :: String,
  90         pkgUrl            :: String,
  91         synopsis          :: String,
  92         description       :: String,
  93         category          :: String,
  94         -- these parts are required by an installed package only:
  95         abiHash           :: AbiHash,
  96         indefinite        :: Bool,
  97         exposed           :: Bool,
  98         -- INVARIANT: if the package is definite, OpenModule's
  99         -- OpenUnitId directly records UnitId.
 100         exposedModules    :: [ExposedModule],
 101         hiddenModules     :: [ModuleName],
 102         trusted           :: Bool,
 103         importDirs        :: [FilePath],
 104         libraryDirs       :: [FilePath],
 105         libraryDynDirs    :: [FilePath],  -- ^ overrides 'libraryDirs'
 106         dataDir           :: FilePath,
 107         hsLibraries       :: [String],
 108         extraLibraries    :: [String],
 109         extraGHCiLibraries:: [String],    -- overrides extraLibraries for GHCi
 110         includeDirs       :: [FilePath],
 111         includes          :: [String],
 112         -- INVARIANT: if the package is definite, UnitId is NOT
 113         -- a ComponentId of an indefinite package
 114         depends           :: [UnitId],
 115         abiDepends        :: [AbiDependency],
 116         ccOptions         :: [String],
 117         ldOptions         :: [String],
 118         frameworkDirs     :: [FilePath],
 119         frameworks        :: [String],
 120         haddockInterfaces :: [FilePath],
 121         haddockHTMLs      :: [FilePath],
 122         pkgRoot           :: Maybe FilePath
 123     }
 124     deriving (Eq, Generic, Typeable, Read, Show)
 125
 126 installedComponentId :: InstalledPackageInfo -> ComponentId
 127 installedComponentId ipi =
 128     case unComponentId (installedComponentId_ ipi) of
 129         "" -> mkComponentId (unUnitId (installedUnitId ipi))
 130         _  -> installedComponentId_ ipi
 131
 132 -- | Get the indefinite unit identity representing this package.
 133 -- This IS NOT guaranteed to give you a substitution; for
 134 -- instantiated packages you will get @DefiniteUnitId (installedUnitId ipi)@.
 135 -- For indefinite libraries, however, you will correctly get
 136 -- an @OpenUnitId@ with the appropriate 'OpenModuleSubst'.
 137 installedOpenUnitId :: InstalledPackageInfo -> OpenUnitId
 138 installedOpenUnitId ipi
 139     = mkOpenUnitId (installedUnitId ipi) (installedComponentId ipi) (Map.fromList (instantiatedWith ipi))
 140
 141 -- | Returns the set of module names which need to be filled for
 142 -- an indefinite package, or the empty set if the package is definite.
 143 requiredSignatures :: InstalledPackageInfo -> Set ModuleName
 144 requiredSignatures ipi = openModuleSubstFreeHoles (Map.fromList (instantiatedWith ipi))
 145
 146 {-# DEPRECATED installedPackageId "Use installedUnitId instead" #-}
 147 -- | Backwards compatibility with Cabal pre-1.24.
 148 -- This type synonym is slightly awful because in cabal-install
 149 -- we define an 'InstalledPackageId' but it's a ComponentId,
 150 -- not a UnitId!
 151 installedPackageId :: InstalledPackageInfo -> UnitId
 152 installedPackageId = installedUnitId
 153
 154 instance Binary InstalledPackageInfo
 155
 156 instance Package.Package InstalledPackageInfo where
 157    packageId = sourcePackageId
 158
 159 instance Package.HasUnitId InstalledPackageInfo where
 160    installedUnitId = installedUnitId
 161
 162 instance Package.PackageInstalled InstalledPackageInfo where
 163    installedDepends = depends
 164
 165 instance IsNode InstalledPackageInfo where
 166     type Key InstalledPackageInfo = UnitId
 167     nodeKey       = installedUnitId
 168     nodeNeighbors = depends
 169
 170 emptyInstalledPackageInfo :: InstalledPackageInfo
 171 emptyInstalledPackageInfo
 172    = InstalledPackageInfo {
 173         sourcePackageId   = PackageIdentifier (mkPackageName "") nullVersion,
 174         installedUnitId   = mkUnitId "",
 175         installedComponentId_ = mkComponentId "",
 176         instantiatedWith  = [],
 177         compatPackageKey  = "",
 178         license           = UnspecifiedLicense,
 179         copyright         = "",
 180         maintainer        = "",
 181         author            = "",
 182         stability         = "",
 183         homepage          = "",
 184         pkgUrl            = "",
 185         synopsis          = "",
 186         description       = "",
 187         category          = "",
 188         abiHash           = mkAbiHash "",
 189         indefinite        = False,
 190         exposed           = False,
 191         exposedModules    = [],
 192         hiddenModules     = [],
 193         trusted           = False,
 194         importDirs        = [],
 195         libraryDirs       = [],
 196         libraryDynDirs    = [],
 197         dataDir           = "",
 198         hsLibraries       = [],
 199         extraLibraries    = [],
 200         extraGHCiLibraries= [],
 201         includeDirs       = [],
 202         includes          = [],
 203         depends           = [],
 204         abiDepends        = [],
 205         ccOptions         = [],
 206         ldOptions         = [],
 207         frameworkDirs     = [],
 208         frameworks        = [],
 209         haddockInterfaces = [],
 210         haddockHTMLs      = [],
 211         pkgRoot           = Nothing
 212     }
 213
 214 -- -----------------------------------------------------------------------------
 215 -- Exposed modules
 216
 217 data ExposedModule
 218    = ExposedModule {
 219        exposedName      :: ModuleName,
 220        exposedReexport  :: Maybe OpenModule
 221      }
 222   deriving (Eq, Generic, Read, Show)
 223
 224 instance Text ExposedModule where
 225     disp (ExposedModule m reexport) =
 226         Disp.hsep [ disp m
 227                   , case reexport of
 228                      Just m' -> Disp.hsep [Disp.text "from", disp m']
 229                      Nothing -> Disp.empty
 230                   ]
 231     parse = do
 232         m <- parseModuleNameQ
 233         Parse.skipSpaces
 234         reexport <- Parse.option Nothing $ do
 235             _ <- Parse.string "from"
 236             Parse.skipSpaces
 237             fmap Just parse
 238         return (ExposedModule m reexport)
 239
 240 instance Binary ExposedModule
 241
 242 -- To maintain backwards-compatibility, we accept both comma/non-comma
 243 -- separated variants of this field.  You SHOULD use the comma syntax if you
 244 -- use any new functions, although actually it's unambiguous due to a quirk
 245 -- of the fact that modules must start with capital letters.
 246
 247 showExposedModules :: [ExposedModule] -> Disp.Doc
 248 showExposedModules xs
 249     | all isExposedModule xs = fsep (map disp xs)
 250     | otherwise = fsep (Disp.punctuate comma (map disp xs))
 251     where isExposedModule (ExposedModule _ Nothing) = True
 252           isExposedModule _ = False
 253
 254 parseExposedModules :: Parse.ReadP r [ExposedModule]
 255 parseExposedModules = parseOptCommaList parse
 256
 257 -- -----------------------------------------------------------------------------
 258 -- ABI dependency
 259
 260 -- | An ABI dependency is a dependency on a library which also
 261 -- records the ABI hash ('abiHash') of the library it depends
 262 -- on.
 263 --
 264 -- The primary utility of this is to enable an extra sanity when
 265 -- GHC loads libraries: it can check if the dependency has a matching
 266 -- ABI and if not, refuse to load this library.  This information
 267 -- is critical if we are shadowing libraries; differences in the
 268 -- ABI hash let us know what packages get shadowed by the new version
 269 -- of a package.
 270 data AbiDependency = AbiDependency {
 271         depUnitId  :: UnitId,
 272         depAbiHash :: AbiHash
 273     }
 274   deriving (Eq, Generic, Read, Show)
 275
 276 instance Text AbiDependency where
 277     disp (AbiDependency uid abi) =
 278         disp uid <<>> Disp.char '=' <<>> disp abi
 279     parse = do
 280         uid <- parse
 281         _ <- Parse.char '='
 282         abi <- parse
 283         return (AbiDependency uid abi)
 284
 285 instance Binary AbiDependency
 286
 287 -- -----------------------------------------------------------------------------
 288 -- Parsing
 289
 290 parseInstalledPackageInfo :: String -> ParseResult InstalledPackageInfo
 291 parseInstalledPackageInfo =
 292     parseFieldsFlat (fieldsInstalledPackageInfo ++ deprecatedFieldDescrs)
 293     emptyInstalledPackageInfo
 294
 295 -- -----------------------------------------------------------------------------
 296 -- Pretty-printing
 297
 298 showInstalledPackageInfo :: InstalledPackageInfo -> String
 299 showInstalledPackageInfo = showFields fieldsInstalledPackageInfo
 300
 301 showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
 302 showInstalledPackageInfoField = showSingleNamedField fieldsInstalledPackageInfo
 303
 304 showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
 305 showSimpleInstalledPackageInfoField = showSimpleSingleNamedField fieldsInstalledPackageInfo
 306
 307 dispCompatPackageKey :: String -> Doc
 308 dispCompatPackageKey = text
 309
 310 parseCompatPackageKey :: Parse.ReadP r String
 311 parseCompatPackageKey = Parse.munch1 uid_char
 312     where uid_char c = Char.isAlphaNum c || c `elem` "-_.=[],:<>+"
 313
 314 -- -----------------------------------------------------------------------------
 315 -- Description of the fields, for parsing/printing
 316
 317 fieldsInstalledPackageInfo :: [FieldDescr InstalledPackageInfo]
 318 fieldsInstalledPackageInfo = basicFieldDescrs ++ installedFieldDescrs
 319
 320 basicFieldDescrs :: [FieldDescr InstalledPackageInfo]
 321 basicFieldDescrs =
 322  [ simpleField "name"
 323                            disp                   (parseMaybeQuoted parse)
 324                            packageName            (\name pkg -> pkg{sourcePackageId=(sourcePackageId pkg){pkgName=name}})
 325  , simpleField "version"
 326                            disp                   parseOptVersion
 327                            packageVersion         (\ver pkg -> pkg{sourcePackageId=(sourcePackageId pkg){pkgVersion=ver}})
 328  , simpleField "id"
 329                            disp                   parse
 330                            installedUnitId             (\pk pkg -> pkg{installedUnitId=pk})
 331  , simpleField "instantiated-with"
 332         (dispOpenModuleSubst . Map.fromList)    (fmap Map.toList parseOpenModuleSubst)
 333         instantiatedWith   (\iw    pkg -> pkg{instantiatedWith=iw})
 334  , simpleField "key"
 335                            dispCompatPackageKey   parseCompatPackageKey
 336                            compatPackageKey       (\pk pkg -> pkg{compatPackageKey=pk})
 337  , simpleField "license"
 338                            disp                   parseLicenseQ
 339                            license                (\l pkg -> pkg{license=l})
 340  , simpleField "copyright"
 341                            showFreeText           parseFreeText
 342                            copyright              (\val pkg -> pkg{copyright=val})
 343  , simpleField "maintainer"
 344                            showFreeText           parseFreeText
 345                            maintainer             (\val pkg -> pkg{maintainer=val})
 346  , simpleField "stability"
 347                            showFreeText           parseFreeText
 348                            stability              (\val pkg -> pkg{stability=val})
 349  , simpleField "homepage"
 350                            showFreeText           parseFreeText
 351                            homepage               (\val pkg -> pkg{homepage=val})
 352  , simpleField "package-url"
 353                            showFreeText           parseFreeText
 354                            pkgUrl                 (\val pkg -> pkg{pkgUrl=val})
 355  , simpleField "synopsis"
 356                            showFreeText           parseFreeText
 357                            synopsis               (\val pkg -> pkg{synopsis=val})
 358  , simpleField "description"
 359                            showFreeText           parseFreeText
 360                            description            (\val pkg -> pkg{description=val})
 361  , simpleField "category"
 362                            showFreeText           parseFreeText
 363                            category               (\val pkg -> pkg{category=val})
 364  , simpleField "author"
 365                            showFreeText           parseFreeText
 366                            author                 (\val pkg -> pkg{author=val})
 367  ]
 368
 369 installedFieldDescrs :: [FieldDescr InstalledPackageInfo]
 370 installedFieldDescrs = [
 371    boolField "exposed"
 372         exposed            (\val pkg -> pkg{exposed=val})
 373  , boolField "indefinite"
 374         indefinite         (\val pkg -> pkg{indefinite=val})
 375  , simpleField "exposed-modules"
 376         showExposedModules parseExposedModules
 377         exposedModules     (\xs    pkg -> pkg{exposedModules=xs})
 378  , listField   "hidden-modules"
 379         disp               parseModuleNameQ
 380         hiddenModules      (\xs    pkg -> pkg{hiddenModules=xs})
 381  , simpleField "abi"
 382         disp               parse
 383         abiHash            (\abi    pkg -> pkg{abiHash=abi})
 384  , boolField   "trusted"
 385         trusted            (\val pkg -> pkg{trusted=val})
 386  , listField   "import-dirs"
 387         showFilePath       parseFilePathQ
 388         importDirs         (\xs pkg -> pkg{importDirs=xs})
 389  , listField   "library-dirs"
 390         showFilePath       parseFilePathQ
 391         libraryDirs        (\xs pkg -> pkg{libraryDirs=xs})
 392  , listField   "dynamic-library-dirs"
 393         showFilePath       parseFilePathQ
 394         libraryDynDirs     (\xs pkg -> pkg{libraryDynDirs=xs})
 395  , simpleField "data-dir"
 396         showFilePath       (parseFilePathQ Parse.<++ return "")
 397         dataDir            (\val pkg -> pkg{dataDir=val})
 398  , listField   "hs-libraries"
 399         showFilePath       parseTokenQ
 400         hsLibraries        (\xs pkg -> pkg{hsLibraries=xs})
 401  , listField   "extra-libraries"
 402         showToken          parseTokenQ
 403         extraLibraries     (\xs pkg -> pkg{extraLibraries=xs})
 404  , listField   "extra-ghci-libraries"
 405         showToken          parseTokenQ
 406         extraGHCiLibraries (\xs pkg -> pkg{extraGHCiLibraries=xs})
 407  , listField   "include-dirs"
 408         showFilePath       parseFilePathQ
 409         includeDirs        (\xs pkg -> pkg{includeDirs=xs})
 410  , listField   "includes"
 411         showFilePath       parseFilePathQ
 412         includes           (\xs pkg -> pkg{includes=xs})
 413  , listField   "depends"
 414         disp               parse
 415         depends            (\xs pkg -> pkg{depends=xs})
 416  , listField   "abi-depends"
 417         disp               parse
 418         abiDepends         (\xs pkg -> pkg{abiDepends=xs})
 419  , listField   "cc-options"
 420         showToken          parseTokenQ
 421         ccOptions          (\path  pkg -> pkg{ccOptions=path})
 422  , listField   "ld-options"
 423         showToken          parseTokenQ
 424         ldOptions          (\path  pkg -> pkg{ldOptions=path})
 425  , listField   "framework-dirs"
 426         showFilePath       parseFilePathQ
 427         frameworkDirs      (\xs pkg -> pkg{frameworkDirs=xs})
 428  , listField   "frameworks"
 429         showToken          parseTokenQ
 430         frameworks         (\xs pkg -> pkg{frameworks=xs})
 431  , listField   "haddock-interfaces"
 432         showFilePath       parseFilePathQ
 433         haddockInterfaces  (\xs pkg -> pkg{haddockInterfaces=xs})
 434  , listField   "haddock-html"
 435         showFilePath       parseFilePathQ
 436         haddockHTMLs       (\xs pkg -> pkg{haddockHTMLs=xs})
 437  , simpleField "pkgroot"
 438         (const Disp.empty)        parseFilePathQ
 439         (fromMaybe "" . pkgRoot)  (\xs pkg -> pkg{pkgRoot=Just xs})
 440  ]
 441
 442 deprecatedFieldDescrs :: [FieldDescr InstalledPackageInfo]
 443 deprecatedFieldDescrs = [
 444    listField   "hugs-options"
 445         showToken          parseTokenQ
 446         (const [])        (const id)
 447   ]