{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeFamilies #-} ----------------------------------------------------------------------------- -- | -- 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(..), installedPackageId, installedComponentId, requiredSignatures, installedOpenUnitId, ExposedModule(..), ParseResult(..), PError(..), PWarning, emptyInstalledPackageInfo, parseInstalledPackageInfo, showInstalledPackageInfo, showInstalledPackageInfoField, showSimpleInstalledPackageInfoField, fieldsInstalledPackageInfo, ) where import Prelude () import Distribution.Compat.Prelude import Distribution.ParseUtils import Distribution.License import Distribution.Package hiding (installedUnitId, installedPackageId) import Distribution.Package.TextClass () import Distribution.Backpack import qualified Distribution.Package as Package import Distribution.ModuleName import Distribution.Version import Distribution.Text import qualified Distribution.Compat.ReadP as Parse import Distribution.Compat.Graph import Text.PrettyPrint as Disp import qualified Data.Char as Char import qualified Data.Map as Map import Data.Set (Set) -- ----------------------------------------------------------------------------- -- The InstalledPackageInfo type -- For BC reasons, we continue to name this record an InstalledPackageInfo; -- but it would more accurately be called an InstalledUnitInfo with Backpack data InstalledPackageInfo = InstalledPackageInfo { -- these parts are exactly the same as PackageDescription sourcePackageId :: PackageId, installedUnitId :: UnitId, installedComponentId_ :: ComponentId, -- INVARIANT: if this package is definite, OpenModule's -- OpenUnitId directly records UnitId. If it is -- indefinite, OpenModule is always an OpenModuleVar -- with the same ModuleName as the key. instantiatedWith :: [(ModuleName, OpenModule)], compatPackageKey :: String, 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: abiHash :: AbiHash, indefinite :: Bool, exposed :: Bool, -- INVARIANT: if the package is definite, OpenModule's -- OpenUnitId directly records UnitId. exposedModules :: [ExposedModule], hiddenModules :: [ModuleName], trusted :: Bool, importDirs :: [FilePath], libraryDirs :: [FilePath], libraryDynDirs :: [FilePath], -- ^ overrides 'libraryDirs' dataDir :: FilePath, hsLibraries :: [String], extraLibraries :: [String], extraGHCiLibraries:: [String], -- overrides extraLibraries for GHCi includeDirs :: [FilePath], includes :: [String], -- INVARIANT: if the package is definite, UnitId is NOT -- a ComponentId of an indefinite package depends :: [UnitId], ccOptions :: [String], ldOptions :: [String], frameworkDirs :: [FilePath], frameworks :: [String], haddockInterfaces :: [FilePath], haddockHTMLs :: [FilePath], pkgRoot :: Maybe FilePath } deriving (Eq, Generic, Typeable, Read, Show) installedComponentId :: InstalledPackageInfo -> ComponentId installedComponentId ipi = case unComponentId (installedComponentId_ ipi) of "" -> mkComponentId (unUnitId (installedUnitId ipi)) _ -> installedComponentId_ ipi -- | Get the indefinite unit identity representing this package. -- This IS NOT guaranteed to give you a substitution; for -- instantiated packages you will get @DefiniteUnitId (installedUnitId ipi)@. -- For indefinite libraries, however, you will correctly get -- an @OpenUnitId@ with the appropriate 'OpenModuleSubst'. installedOpenUnitId :: InstalledPackageInfo -> OpenUnitId installedOpenUnitId ipi = mkOpenUnitId (installedUnitId ipi) (installedComponentId ipi) (Map.fromList (instantiatedWith ipi)) -- | Returns the set of module names which need to be filled for -- an indefinite package, or the empty set if the package is definite. requiredSignatures :: InstalledPackageInfo -> Set ModuleName requiredSignatures ipi = openModuleSubstFreeHoles (Map.fromList (instantiatedWith ipi)) {-# DEPRECATED installedPackageId "Use installedUnitId instead" #-} -- | Backwards compatibility with Cabal pre-1.24. -- This type synonym is slightly awful because in cabal-install -- we define an 'InstalledPackageId' but it's a ComponentId, -- not a UnitId! installedPackageId :: InstalledPackageInfo -> UnitId installedPackageId = installedUnitId instance Binary InstalledPackageInfo instance Package.Package InstalledPackageInfo where packageId = sourcePackageId instance Package.HasUnitId InstalledPackageInfo where installedUnitId = installedUnitId instance Package.PackageInstalled InstalledPackageInfo where installedDepends = depends instance IsNode InstalledPackageInfo where type Key InstalledPackageInfo = UnitId nodeKey = installedUnitId nodeNeighbors = depends emptyInstalledPackageInfo :: InstalledPackageInfo emptyInstalledPackageInfo = InstalledPackageInfo { sourcePackageId = PackageIdentifier (mkPackageName "") nullVersion, installedUnitId = mkUnitId "", installedComponentId_ = mkComponentId "", instantiatedWith = [], compatPackageKey = "", license = UnspecifiedLicense, copyright = "", maintainer = "", author = "", stability = "", homepage = "", pkgUrl = "", synopsis = "", description = "", category = "", abiHash = mkAbiHash "", indefinite = False, exposed = False, exposedModules = [], hiddenModules = [], trusted = False, importDirs = [], libraryDirs = [], libraryDynDirs = [], dataDir = "", hsLibraries = [], extraLibraries = [], extraGHCiLibraries= [], includeDirs = [], includes = [], depends = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = [], haddockHTMLs = [], pkgRoot = Nothing } -- ----------------------------------------------------------------------------- -- Exposed modules data ExposedModule = ExposedModule { exposedName :: ModuleName, exposedReexport :: Maybe OpenModule } deriving (Eq, Generic, Read, Show) instance Text ExposedModule where disp (ExposedModule m reexport) = Disp.hsep [ disp m , case reexport of Just m' -> Disp.hsep [Disp.text "from", disp m'] Nothing -> Disp.empty ] parse = do m <- parseModuleNameQ Parse.skipSpaces reexport <- Parse.option Nothing $ do _ <- Parse.string "from" Parse.skipSpaces fmap Just parse return (ExposedModule m reexport) 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) = True isExposedModule _ = False parseExposedModules :: Parse.ReadP r [ExposedModule] parseExposedModules = parseOptCommaList parse -- ----------------------------------------------------------------------------- -- Parsing parseInstalledPackageInfo :: String -> ParseResult InstalledPackageInfo parseInstalledPackageInfo = parseFieldsFlat (fieldsInstalledPackageInfo ++ deprecatedFieldDescrs) emptyInstalledPackageInfo -- ----------------------------------------------------------------------------- -- Pretty-printing showInstalledPackageInfo :: InstalledPackageInfo -> String showInstalledPackageInfo = showFields fieldsInstalledPackageInfo showInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String) showInstalledPackageInfoField = showSingleNamedField fieldsInstalledPackageInfo showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String) showSimpleInstalledPackageInfoField = showSimpleSingleNamedField fieldsInstalledPackageInfo dispCompatPackageKey :: String -> Doc dispCompatPackageKey = text parseCompatPackageKey :: Parse.ReadP r String parseCompatPackageKey = Parse.munch1 uid_char where uid_char c = Char.isAlphaNum c || c `elem` "-_.=[],:<>+" -- ----------------------------------------------------------------------------- -- 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 installedUnitId (\pk pkg -> pkg{installedUnitId=pk}) , simpleField "instantiated-with" (dispOpenModuleSubst . Map.fromList) (fmap Map.toList parseOpenModuleSubst) instantiatedWith (\iw pkg -> pkg{instantiatedWith=iw}) , simpleField "key" dispCompatPackageKey parseCompatPackageKey compatPackageKey (\pk pkg -> pkg{compatPackageKey=pk}) , 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}) , boolField "indefinite" indefinite (\val pkg -> pkg{indefinite=val}) , simpleField "exposed-modules" showExposedModules parseExposedModules exposedModules (\xs pkg -> pkg{exposedModules=xs}) , listField "hidden-modules" disp parseModuleNameQ hiddenModules (\xs pkg -> pkg{hiddenModules=xs}) , simpleField "abi" disp parse abiHash (\abi pkg -> pkg{abiHash=abi}) , 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}) , listField "dynamic-library-dirs" showFilePath parseFilePathQ libraryDynDirs (\xs pkg -> pkg{libraryDynDirs=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) ]