Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

394 lines (354 sloc) 15.986 kb
{-# LANGUAGE DeriveGeneric #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.InstalledPackageInfo
-- Copyright : (c) The University of Glasgow 2004
--
-- Maintainer : libraries@haskell.org
-- Portability : portable
--
-- This is the information about an /installed/ package that
-- is communicated to the @ghc-pkg@ program in order to register
-- a package. @ghc-pkg@ now consumes this package format (as of version
-- 6.4). This is specific to GHC at the moment.
--
-- The @.cabal@ file format is for describing a package that is not yet
-- installed. It has a lot of flexibility, like conditionals and dependency
-- ranges. As such, that format is not at all suitable for describing a package
-- that has already been built and installed. By the time we get to that stage,
-- we have resolved all conditionals and resolved dependency version
-- constraints to exact versions of dependent packages. So, this module defines
-- the 'InstalledPackageInfo' data structure that contains all the info we keep
-- about an installed package. There is a parser and pretty printer. The
-- textual format is rather simpler than the @.cabal@ format: there are no
-- sections, for example.
-- This module is meant to be local-only to Distribution...
module Distribution.InstalledPackageInfo (
InstalledPackageInfo_(..), InstalledPackageInfo,
OriginalModule(..), ExposedModule(..),
ParseResult(..), PError(..), PWarning,
emptyInstalledPackageInfo,
parseInstalledPackageInfo,
showInstalledPackageInfo,
showInstalledPackageInfoField,
showSimpleInstalledPackageInfoField,
fieldsInstalledPackageInfo,
) where
import Distribution.ParseUtils
( FieldDescr(..), ParseResult(..), PError(..), PWarning
, simpleField, listField, parseLicenseQ
, showFields, showSingleNamedField, showSimpleSingleNamedField
, parseFieldsFlat
, parseFilePathQ, parseTokenQ, parseModuleNameQ, parsePackageNameQ
, showFilePath, showToken, boolField, parseOptVersion
, parseFreeText, showFreeText, parseOptCommaList )
import Distribution.License ( License(..) )
import Distribution.Package
( PackageName(..), PackageIdentifier(..)
, PackageId, InstalledPackageId(..)
, packageName, packageVersion, PackageKey(..) )
import qualified Distribution.Package as Package
import Distribution.ModuleName
( ModuleName )
import Distribution.Version
( Version(..) )
import Distribution.Text
( Text(disp, parse) )
import Text.PrettyPrint as Disp
import qualified Distribution.Compat.ReadP as Parse
import Distribution.Compat.Binary (Binary)
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
-- -----------------------------------------------------------------------------
-- The InstalledPackageInfo type
data InstalledPackageInfo_ m
= InstalledPackageInfo {
-- these parts are exactly the same as PackageDescription
installedPackageId :: InstalledPackageId,
sourcePackageId :: PackageId,
packageKey :: PackageKey,
license :: License,
copyright :: String,
maintainer :: String,
author :: String,
stability :: String,
homepage :: String,
pkgUrl :: String,
synopsis :: String,
description :: String,
category :: String,
-- these parts are required by an installed package only:
exposed :: Bool,
exposedModules :: [ExposedModule],
instantiatedWith :: [(m, OriginalModule)],
hiddenModules :: [m],
trusted :: Bool,
importDirs :: [FilePath],
libraryDirs :: [FilePath],
dataDir :: FilePath,
hsLibraries :: [String],
extraLibraries :: [String],
extraGHCiLibraries:: [String], -- overrides extraLibraries for GHCi
includeDirs :: [FilePath],
includes :: [String],
depends :: [InstalledPackageId],
ccOptions :: [String],
ldOptions :: [String],
frameworkDirs :: [FilePath],
frameworks :: [String],
haddockInterfaces :: [FilePath],
haddockHTMLs :: [FilePath],
pkgRoot :: Maybe FilePath
}
deriving (Generic, Read, Show)
instance Binary m => Binary (InstalledPackageInfo_ m)
instance Package.Package (InstalledPackageInfo_ str) where
packageId = sourcePackageId
instance Package.HasInstalledPackageId (InstalledPackageInfo_ str) where
installedPackageId = installedPackageId
instance Package.PackageInstalled (InstalledPackageInfo_ str) where
installedDepends = depends
type InstalledPackageInfo = InstalledPackageInfo_ ModuleName
emptyInstalledPackageInfo :: InstalledPackageInfo_ m
emptyInstalledPackageInfo
= InstalledPackageInfo {
installedPackageId = InstalledPackageId "",
sourcePackageId = PackageIdentifier (PackageName "") noVersion,
packageKey = OldPackageKey (PackageIdentifier
(PackageName "") noVersion),
license = UnspecifiedLicense,
copyright = "",
maintainer = "",
author = "",
stability = "",
homepage = "",
pkgUrl = "",
synopsis = "",
description = "",
category = "",
exposed = False,
exposedModules = [],
hiddenModules = [],
instantiatedWith = [],
trusted = False,
importDirs = [],
libraryDirs = [],
dataDir = "",
hsLibraries = [],
extraLibraries = [],
extraGHCiLibraries= [],
includeDirs = [],
includes = [],
depends = [],
ccOptions = [],
ldOptions = [],
frameworkDirs = [],
frameworks = [],
haddockInterfaces = [],
haddockHTMLs = [],
pkgRoot = Nothing
}
noVersion :: Version
noVersion = Version [] []
-- -----------------------------------------------------------------------------
-- Exposed modules
data OriginalModule
= OriginalModule {
originalPackageId :: InstalledPackageId,
originalModuleName :: ModuleName
}
deriving (Generic, Eq, Read, Show)
data ExposedModule
= ExposedModule {
exposedName :: ModuleName,
exposedReexport :: Maybe OriginalModule,
exposedSignature :: Maybe OriginalModule -- This field is unused for now.
}
deriving (Generic, Read, Show)
instance Text OriginalModule where
disp (OriginalModule ipi m) =
disp ipi <> Disp.char ':' <> disp m
parse = do
ipi <- parse
_ <- Parse.char ':'
m <- parse
return (OriginalModule ipi m)
instance Text ExposedModule where
disp (ExposedModule m reexport signature) =
Disp.sep [ disp m
, case reexport of
Just m' -> Disp.sep [Disp.text "from", disp m']
Nothing -> Disp.empty
, case signature of
Just m' -> Disp.sep [Disp.text "is", disp m']
Nothing -> Disp.empty
]
parse = do
m <- parseModuleNameQ
Parse.skipSpaces
reexport <- Parse.option Nothing $ do
_ <- Parse.string "from"
Parse.skipSpaces
fmap Just parse
Parse.skipSpaces
signature <- Parse.option Nothing $ do
_ <- Parse.string "is"
Parse.skipSpaces
fmap Just parse
return (ExposedModule m reexport signature)
instance Binary OriginalModule
instance Binary ExposedModule
-- To maintain backwards-compatibility, we accept both comma/non-comma
-- separated variants of this field. You SHOULD use the comma syntax if you
-- use any new functions, although actually it's unambiguous due to a quirk
-- of the fact that modules must start with capital letters.
showExposedModules :: [ExposedModule] -> Disp.Doc
showExposedModules xs
| all isExposedModule xs = fsep (map disp xs)
| otherwise = fsep (Disp.punctuate comma (map disp xs))
where isExposedModule (ExposedModule _ Nothing Nothing) = True
isExposedModule _ = False
parseExposedModules :: Parse.ReadP r [ExposedModule]
parseExposedModules = parseOptCommaList parse
-- -----------------------------------------------------------------------------
-- Parsing
parseInstalledPackageInfo :: String -> ParseResult InstalledPackageInfo
parseInstalledPackageInfo =
parseFieldsFlat (fieldsInstalledPackageInfo ++ deprecatedFieldDescrs)
emptyInstalledPackageInfo
parseInstantiatedWith :: Parse.ReadP r (ModuleName, OriginalModule)
parseInstantiatedWith = do k <- parse
_ <- Parse.char '='
n <- parse
_ <- Parse.char '@'
p <- parse
return (k, OriginalModule p n)
-- -----------------------------------------------------------------------------
-- Pretty-printing
showInstalledPackageInfo :: InstalledPackageInfo -> String
showInstalledPackageInfo = showFields fieldsInstalledPackageInfo
showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
showInstalledPackageInfoField = showSingleNamedField fieldsInstalledPackageInfo
showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
showSimpleInstalledPackageInfoField = showSimpleSingleNamedField fieldsInstalledPackageInfo
showInstantiatedWith :: (ModuleName, OriginalModule) -> Doc
showInstantiatedWith (k, OriginalModule p m) = disp k <> text "=" <> disp m <> text "@" <> disp p
-- -----------------------------------------------------------------------------
-- Description of the fields, for parsing/printing
fieldsInstalledPackageInfo :: [FieldDescr InstalledPackageInfo]
fieldsInstalledPackageInfo = basicFieldDescrs ++ installedFieldDescrs
basicFieldDescrs :: [FieldDescr InstalledPackageInfo]
basicFieldDescrs =
[ simpleField "name"
disp parsePackageNameQ
packageName (\name pkg -> pkg{sourcePackageId=(sourcePackageId pkg){pkgName=name}})
, simpleField "version"
disp parseOptVersion
packageVersion (\ver pkg -> pkg{sourcePackageId=(sourcePackageId pkg){pkgVersion=ver}})
, simpleField "id"
disp parse
installedPackageId (\ipid pkg -> pkg{installedPackageId=ipid})
, simpleField "key"
disp parse
packageKey (\ipid pkg -> pkg{packageKey=ipid})
, simpleField "license"
disp parseLicenseQ
license (\l pkg -> pkg{license=l})
, simpleField "copyright"
showFreeText parseFreeText
copyright (\val pkg -> pkg{copyright=val})
, simpleField "maintainer"
showFreeText parseFreeText
maintainer (\val pkg -> pkg{maintainer=val})
, simpleField "stability"
showFreeText parseFreeText
stability (\val pkg -> pkg{stability=val})
, simpleField "homepage"
showFreeText parseFreeText
homepage (\val pkg -> pkg{homepage=val})
, simpleField "package-url"
showFreeText parseFreeText
pkgUrl (\val pkg -> pkg{pkgUrl=val})
, simpleField "synopsis"
showFreeText parseFreeText
synopsis (\val pkg -> pkg{synopsis=val})
, simpleField "description"
showFreeText parseFreeText
description (\val pkg -> pkg{description=val})
, simpleField "category"
showFreeText parseFreeText
category (\val pkg -> pkg{category=val})
, simpleField "author"
showFreeText parseFreeText
author (\val pkg -> pkg{author=val})
]
installedFieldDescrs :: [FieldDescr InstalledPackageInfo]
installedFieldDescrs = [
boolField "exposed"
exposed (\val pkg -> pkg{exposed=val})
, simpleField "exposed-modules"
showExposedModules parseExposedModules
exposedModules (\xs pkg -> pkg{exposedModules=xs})
, listField "hidden-modules"
disp parseModuleNameQ
hiddenModules (\xs pkg -> pkg{hiddenModules=xs})
, listField "instantiated-with"
showInstantiatedWith parseInstantiatedWith
instantiatedWith (\xs pkg -> pkg{instantiatedWith=xs})
, boolField "trusted"
trusted (\val pkg -> pkg{trusted=val})
, listField "import-dirs"
showFilePath parseFilePathQ
importDirs (\xs pkg -> pkg{importDirs=xs})
, listField "library-dirs"
showFilePath parseFilePathQ
libraryDirs (\xs pkg -> pkg{libraryDirs=xs})
, simpleField "data-dir"
showFilePath (parseFilePathQ Parse.<++ return "")
dataDir (\val pkg -> pkg{dataDir=val})
, listField "hs-libraries"
showFilePath parseTokenQ
hsLibraries (\xs pkg -> pkg{hsLibraries=xs})
, listField "extra-libraries"
showToken parseTokenQ
extraLibraries (\xs pkg -> pkg{extraLibraries=xs})
, listField "extra-ghci-libraries"
showToken parseTokenQ
extraGHCiLibraries (\xs pkg -> pkg{extraGHCiLibraries=xs})
, listField "include-dirs"
showFilePath parseFilePathQ
includeDirs (\xs pkg -> pkg{includeDirs=xs})
, listField "includes"
showFilePath parseFilePathQ
includes (\xs pkg -> pkg{includes=xs})
, listField "depends"
disp parse
depends (\xs pkg -> pkg{depends=xs})
, listField "cc-options"
showToken parseTokenQ
ccOptions (\path pkg -> pkg{ccOptions=path})
, listField "ld-options"
showToken parseTokenQ
ldOptions (\path pkg -> pkg{ldOptions=path})
, listField "framework-dirs"
showFilePath parseFilePathQ
frameworkDirs (\xs pkg -> pkg{frameworkDirs=xs})
, listField "frameworks"
showToken parseTokenQ
frameworks (\xs pkg -> pkg{frameworks=xs})
, listField "haddock-interfaces"
showFilePath parseFilePathQ
haddockInterfaces (\xs pkg -> pkg{haddockInterfaces=xs})
, listField "haddock-html"
showFilePath parseFilePathQ
haddockHTMLs (\xs pkg -> pkg{haddockHTMLs=xs})
, simpleField "pkgroot"
(const Disp.empty) parseFilePathQ
(fromMaybe "" . pkgRoot) (\xs pkg -> pkg{pkgRoot=Just xs})
]
deprecatedFieldDescrs :: [FieldDescr InstalledPackageInfo]
deprecatedFieldDescrs = [
listField "hugs-options"
showToken parseTokenQ
(const []) (const id)
]
Jump to Line
Something went wrong with that request. Please try again.