{-# LANGUAGE CPP, RecordWildCards, FlexibleInstances, MultiParamTypeClasses #-}
module UnitInfo (
packageConfigId,
expandedUnitInfoId,
definiteUnitInfoId,
installedUnitInfoId,
UnitInfo,
InstalledPackageInfo(..),
ComponentId(..),
SourcePackageId(..),
PackageName(..),
Version(..),
defaultUnitInfo,
sourcePackageIdString,
packageNameString,
pprUnitInfo,
) where
#include "HsVersions.h"
import GhcPrelude
import GHC.PackageDb
import Data.Version
import FastString
import Outputable
import Module
import Unique
type UnitInfo = InstalledPackageInfo
ComponentId
SourcePackageId
PackageName
Module.InstalledUnitId
Module.UnitId
Module.ModuleName
Module.Module
newtype SourcePackageId = SourcePackageId FastString deriving (Eq, Ord)
newtype PackageName = PackageName FastString deriving (Eq, Ord)
instance BinaryStringRep SourcePackageId where
fromStringRep = SourcePackageId . mkFastStringByteString
toStringRep (SourcePackageId s) = bytesFS s
instance BinaryStringRep PackageName where
fromStringRep = PackageName . mkFastStringByteString
toStringRep (PackageName s) = bytesFS s
instance Uniquable SourcePackageId where
getUnique (SourcePackageId n) = getUnique n
instance Uniquable PackageName where
getUnique (PackageName n) = getUnique n
instance Outputable SourcePackageId where
ppr (SourcePackageId str) = ftext str
instance Outputable PackageName where
ppr (PackageName str) = ftext str
defaultUnitInfo :: UnitInfo
defaultUnitInfo = emptyInstalledPackageInfo
sourcePackageIdString :: UnitInfo -> String
sourcePackageIdString pkg = unpackFS str
where
SourcePackageId str = sourcePackageId pkg
packageNameString :: UnitInfo -> String
packageNameString pkg = unpackFS str
where
PackageName str = packageName pkg
pprUnitInfo :: UnitInfo -> SDoc
pprUnitInfo InstalledPackageInfo {..} =
vcat [
field "name" (ppr packageName),
field "version" (text (showVersion packageVersion)),
field "id" (ppr unitId),
field "exposed" (ppr exposed),
field "exposed-modules" (ppr 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 "dynamic-library-dirs" (fsep (map text libraryDynDirs)),
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
installedUnitInfoId :: UnitInfo -> InstalledUnitId
installedUnitInfoId = unitId
packageConfigId :: UnitInfo -> UnitId
packageConfigId p =
if indefinite p
then newUnitId (componentId p) (instantiatedWith p)
else DefiniteUnitId (DefUnitId (unitId p))
expandedUnitInfoId :: UnitInfo -> UnitId
expandedUnitInfoId p =
newUnitId (componentId p) (instantiatedWith p)
definiteUnitInfoId :: UnitInfo -> Maybe DefUnitId
definiteUnitInfoId p =
case packageConfigId p of
DefiniteUnitId def_uid -> Just def_uid
_ -> Nothing