module Distribution.InstalledPackageInfo (
InstalledPackageInfo(..),
installedPackageId,
installedComponentId,
installedOpenUnitId,
sourceComponentName,
requiredSignatures,
ExposedModule(..),
AbiDependency(..),
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.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 Distribution.Types.MungedPackageId
import Distribution.Types.ComponentName
import Distribution.Types.MungedPackageName
import Distribution.Types.UnqualComponentName
import Text.PrettyPrint as Disp
import qualified Data.Char as Char
import qualified Data.Map as Map
import Data.Set (Set)
data InstalledPackageInfo
= InstalledPackageInfo {
sourcePackageId :: PackageId,
installedUnitId :: UnitId,
installedComponentId_ :: ComponentId,
instantiatedWith :: [(ModuleName, OpenModule)],
sourceLibName :: Maybe UnqualComponentName,
compatPackageKey :: String,
license :: License,
copyright :: String,
maintainer :: String,
author :: String,
stability :: String,
homepage :: String,
pkgUrl :: String,
synopsis :: String,
description :: String,
category :: String,
abiHash :: AbiHash,
indefinite :: Bool,
exposed :: Bool,
exposedModules :: [ExposedModule],
hiddenModules :: [ModuleName],
trusted :: Bool,
importDirs :: [FilePath],
libraryDirs :: [FilePath],
libraryDynDirs :: [FilePath],
dataDir :: FilePath,
hsLibraries :: [String],
extraLibraries :: [String],
extraGHCiLibraries:: [String],
includeDirs :: [FilePath],
includes :: [String],
depends :: [UnitId],
abiDepends :: [AbiDependency],
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
installedOpenUnitId :: InstalledPackageInfo -> OpenUnitId
installedOpenUnitId ipi
= mkOpenUnitId (installedUnitId ipi) (installedComponentId ipi) (Map.fromList (instantiatedWith ipi))
requiredSignatures :: InstalledPackageInfo -> Set ModuleName
requiredSignatures ipi = openModuleSubstFreeHoles (Map.fromList (instantiatedWith ipi))
installedPackageId :: InstalledPackageInfo -> UnitId
installedPackageId = installedUnitId
instance Binary InstalledPackageInfo
instance Package.HasMungedPackageId InstalledPackageInfo where
mungedId = mungedPackageId
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 = [],
sourceLibName = Nothing,
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 = [],
abiDepends = [],
ccOptions = [],
ldOptions = [],
frameworkDirs = [],
frameworks = [],
haddockInterfaces = [],
haddockHTMLs = [],
pkgRoot = Nothing
}
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
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
dispMaybe :: Text a => Maybe a -> Disp.Doc
dispMaybe Nothing = Disp.empty
dispMaybe (Just x) = disp x
parseMaybe :: Text a => Parse.ReadP r (Maybe a)
parseMaybe = fmap Just parse Parse.<++ return Nothing
data AbiDependency = AbiDependency {
depUnitId :: UnitId,
depAbiHash :: AbiHash
}
deriving (Eq, Generic, Read, Show)
instance Text AbiDependency where
disp (AbiDependency uid abi) =
disp uid <<>> Disp.char '=' <<>> disp abi
parse = do
uid <- parse
_ <- Parse.char '='
abi <- parse
return (AbiDependency uid abi)
instance Binary AbiDependency
sourceComponentName :: InstalledPackageInfo -> ComponentName
sourceComponentName ipi =
case sourceLibName ipi of
Nothing -> CLibName
Just qn -> CSubLibName qn
maybePackageName :: InstalledPackageInfo -> Maybe PackageName
maybePackageName ipi =
case sourceLibName ipi of
Nothing -> Nothing
Just _ -> Just (packageName ipi)
setMaybePackageName :: Maybe PackageName -> InstalledPackageInfo -> InstalledPackageInfo
setMaybePackageName Nothing ipi = ipi
setMaybePackageName (Just pn) ipi = ipi {
sourcePackageId=(sourcePackageId ipi){pkgName=pn}
}
mungedPackageName :: InstalledPackageInfo -> MungedPackageName
mungedPackageName ipi =
computeCompatPackageName
(packageName ipi)
(sourceLibName ipi)
setMungedPackageName :: MungedPackageName -> InstalledPackageInfo -> InstalledPackageInfo
setMungedPackageName mpn ipi =
let (pn, mb_uqn) = decodeCompatPackageName mpn
in ipi {
sourcePackageId = (sourcePackageId ipi) {pkgName=pn},
sourceLibName = mb_uqn
}
mungedPackageId :: InstalledPackageInfo -> MungedPackageId
mungedPackageId ipi =
MungedPackageId (mungedPackageName ipi) (packageVersion ipi)
parseInstalledPackageInfo :: String -> ParseResult InstalledPackageInfo
parseInstalledPackageInfo =
parseFieldsFlat (fieldsInstalledPackageInfo ++ deprecatedFieldDescrs)
emptyInstalledPackageInfo
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` "-_.=[],:<>+"
fieldsInstalledPackageInfo :: [FieldDescr InstalledPackageInfo]
fieldsInstalledPackageInfo = basicFieldDescrs ++ installedFieldDescrs
basicFieldDescrs :: [FieldDescr InstalledPackageInfo]
basicFieldDescrs =
[ simpleField "name"
disp (parseMaybeQuoted parse)
mungedPackageName setMungedPackageName
, 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 "package-name"
dispMaybe parseMaybe
maybePackageName setMaybePackageName
, simpleField "lib-name"
dispMaybe parseMaybe
sourceLibName (\n pkg -> pkg{sourceLibName=n})
, 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 "abi-depends"
disp parse
abiDepends (\xs pkg -> pkg{abiDepends=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)
]