module PackageConfig (
packageConfigId,
PackageConfig,
InstalledPackageInfo(..),
ComponentId(..),
SourcePackageId(..),
PackageName(..),
Version(..),
defaultPackageConfig,
sourcePackageIdString,
packageNameString,
pprPackageConfig,
) where
#include "HsVersions.h"
import GHC.PackageDb
import Data.Version
import FastString
import Outputable
import Module
import Unique
type PackageConfig = InstalledPackageInfo
SourcePackageId
PackageName
Module.UnitId
Module.ModuleName
newtype ComponentId = ComponentId FastString deriving (Eq, Ord)
newtype SourcePackageId = SourcePackageId FastString deriving (Eq, Ord)
newtype PackageName = PackageName FastString deriving (Eq, Ord)
instance BinaryStringRep ComponentId where
fromStringRep = ComponentId . mkFastStringByteString
toStringRep (ComponentId s) = fastStringToByteString s
instance BinaryStringRep SourcePackageId where
fromStringRep = SourcePackageId . mkFastStringByteString
toStringRep (SourcePackageId s) = fastStringToByteString s
instance BinaryStringRep PackageName where
fromStringRep = PackageName . mkFastStringByteString
toStringRep (PackageName s) = fastStringToByteString s
instance Uniquable ComponentId where
getUnique (ComponentId n) = getUnique n
instance Uniquable SourcePackageId where
getUnique (SourcePackageId n) = getUnique n
instance Uniquable PackageName where
getUnique (PackageName n) = getUnique n
instance Outputable ComponentId where
ppr (ComponentId str) = ftext str
instance Outputable SourcePackageId where
ppr (SourcePackageId str) = ftext str
instance Outputable PackageName where
ppr (PackageName str) = ftext str
pprExposedModule :: (Outputable a, Outputable b) => ExposedModule a b -> SDoc
pprExposedModule (ExposedModule exposedName exposedReexport) =
sep [ ppr exposedName
, case exposedReexport of
Just m -> sep [text "from", pprOriginalModule m]
Nothing -> empty
]
pprOriginalModule :: (Outputable a, Outputable b) => OriginalModule a b -> SDoc
pprOriginalModule (OriginalModule originalPackageId originalModuleName) =
ppr originalPackageId <> char ':' <> ppr originalModuleName
defaultPackageConfig :: PackageConfig
defaultPackageConfig = emptyInstalledPackageInfo
sourcePackageIdString :: PackageConfig -> String
sourcePackageIdString pkg = unpackFS str
where
SourcePackageId str = sourcePackageId pkg
packageNameString :: PackageConfig -> String
packageNameString pkg = unpackFS str
where
PackageName str = packageName pkg
pprPackageConfig :: PackageConfig -> SDoc
pprPackageConfig InstalledPackageInfo {..} =
vcat [
field "name" (ppr packageName),
field "version" (text (showVersion packageVersion)),
field "id" (ppr unitId),
field "exposed" (ppr exposed),
field "exposed-modules"
(if all isExposedModule exposedModules
then fsep (map pprExposedModule exposedModules)
else pprWithCommas pprExposedModule exposedModules),
field "hidden-modules" (fsep (map ppr hiddenModules)),
field "trusted" (ppr trusted),
field "import-dirs" (fsep (map text importDirs)),
field "library-dirs" (fsep (map text libraryDirs)),
field "hs-libraries" (fsep (map text hsLibraries)),
field "extra-libraries" (fsep (map text extraLibraries)),
field "extra-ghci-libraries" (fsep (map text extraGHCiLibraries)),
field "include-dirs" (fsep (map text includeDirs)),
field "includes" (fsep (map text includes)),
field "depends" (fsep (map ppr depends)),
field "cc-options" (fsep (map text ccOptions)),
field "ld-options" (fsep (map text ldOptions)),
field "framework-dirs" (fsep (map text frameworkDirs)),
field "frameworks" (fsep (map text frameworks)),
field "haddock-interfaces" (fsep (map text haddockInterfaces)),
field "haddock-html" (fsep (map text haddockHTMLs))
]
where
field name body = text name <> colon <+> nest 4 body
isExposedModule (ExposedModule _ Nothing) = True
isExposedModule _ = False
packageConfigId :: PackageConfig -> UnitId
packageConfigId = unitId