GHC/Unit/Info.hs

    {-# LANGUAGE CPP, RecordWildCards, FlexibleInstances, MultiParamTypeClasses #-}

    -- | Info about installed units (compiled libraries)
    module GHC.Unit.Info
       ( GenericUnitInfo (..)
       , GenUnitInfo
       , UnitInfo
       , UnitKey (..)
       , UnitKeyInfo
       , mkUnitKeyInfo
       , mapUnitInfo
       , mkUnitPprInfo

       , mkUnit

       , PackageId(..)
       , PackageName(..)
       , Version(..)
       , unitPackageNameString
       , unitPackageIdString
       , pprUnitInfo
       )
    where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Unit.Database
    import Data.Version
    import Data.Bifunctor

    import GHC.Data.FastString
    import GHC.Utils.Outputable
    import GHC.Unit.Module as Module
    import GHC.Types.Unique
    import GHC.Unit.Ppr

    -- | Information about an installed unit
    --
    -- We parameterize on the unit identifier:
    --    * UnitKey: identifier used in the database (cf 'UnitKeyInfo')
    --    * UnitId: identifier used to generate code (cf 'UnitInfo')
    --
    -- These two identifiers are different for wired-in packages. See Note [About
    -- Units] in "GHC.Unit"
    type GenUnitInfo unit = GenericUnitInfo (Indefinite unit) PackageId PackageName unit ModuleName (GenModule (GenUnit unit))

    -- | A unit key in the database
    newtype UnitKey = UnitKey FastString

    unitKeyFS :: UnitKey -> FastString
    unitKeyFS (UnitKey fs) = fs

    -- | Information about an installed unit (units are identified by their database
    -- UnitKey)
    type UnitKeyInfo = GenUnitInfo UnitKey

    -- | Information about an installed unit (units are identified by their internal
    -- UnitId)
    type UnitInfo    = GenUnitInfo UnitId

    -- | Convert a DbUnitInfo (read from a package database) into `UnitKeyInfo`
    mkUnitKeyInfo :: DbUnitInfo -> UnitKeyInfo
    mkUnitKeyInfo = mapGenericUnitInfo
       mkUnitKey'
       mkIndefUnitKey'
       mkPackageIdentifier'
       mkPackageName'
       mkModuleName'
       mkModule'
       where
         mkPackageIdentifier' = PackageId      . mkFastStringByteString
         mkPackageName'       = PackageName    . mkFastStringByteString
         mkUnitKey'           = UnitKey        . mkFastStringByteString
         mkModuleName'        = mkModuleNameFS . mkFastStringByteString
         mkIndefUnitKey' cid  = Indefinite (mkUnitKey' cid) Nothing
         mkVirtUnitKey' i = case i of
          DbInstUnitId cid insts -> mkGenVirtUnit unitKeyFS (mkIndefUnitKey' cid) (fmap (bimap mkModuleName' mkModule') insts)
          DbUnitId uid           -> RealUnit (Definite (mkUnitKey' uid))
         mkModule' m = case m of
           DbModule uid n -> mkModule (mkVirtUnitKey' uid) (mkModuleName' n)
           DbModuleVar  n -> mkHoleModule (mkModuleName' n)

    -- | Map over the unit parameter
    mapUnitInfo :: (u -> v) -> (v -> FastString) -> GenUnitInfo u -> GenUnitInfo v
    mapUnitInfo f gunitFS = mapGenericUnitInfo
       f         -- unit identifier
       (fmap f)  -- indefinite unit identifier
       id        -- package identifier
       id        -- package name
       id        -- module name
       (fmap (mapGenUnit f gunitFS)) -- instantiating modules

    -- TODO: there's no need for these to be FastString, as we don't need the uniq
    --       feature, but ghc doesn't currently have convenient support for any
    --       other compact string types, e.g. plain ByteString or Text.

    newtype PackageId   = PackageId    FastString deriving (Eq, Ord)
    newtype PackageName = PackageName
       { unPackageName :: FastString
       }
       deriving (Eq, Ord)

    instance Uniquable PackageId where
      getUnique (PackageId n) = getUnique n

    instance Uniquable PackageName where
      getUnique (PackageName n) = getUnique n

    instance Outputable PackageId where
      ppr (PackageId str) = ftext str

    instance Outputable PackageName where
      ppr (PackageName str) = ftext str

    unitPackageIdString :: GenUnitInfo u -> String
    unitPackageIdString pkg = unpackFS str
      where
        PackageId str = unitPackageId pkg

    unitPackageNameString :: GenUnitInfo u -> String
    unitPackageNameString pkg = unpackFS str
      where
        PackageName str = unitPackageName pkg

    pprUnitInfo :: UnitInfo -> SDoc
    pprUnitInfo GenericUnitInfo {..} =
        vcat [
          field "name"                 (ppr unitPackageName),
          field "version"              (text (showVersion unitPackageVersion)),
          field "id"                   (ppr unitId),
          field "exposed"              (ppr unitIsExposed),
          field "exposed-modules"      (ppr unitExposedModules),
          field "hidden-modules"       (fsep (map ppr unitHiddenModules)),
          field "trusted"              (ppr unitIsTrusted),
          field "import-dirs"          (fsep (map text unitImportDirs)),
          field "library-dirs"         (fsep (map text unitLibraryDirs)),
          field "dynamic-library-dirs" (fsep (map text unitLibraryDynDirs)),
          field "hs-libraries"         (fsep (map text unitLibraries)),
          field "extra-libraries"      (fsep (map text unitExtDepLibsSys)),
          field "extra-ghci-libraries" (fsep (map text unitExtDepLibsGhc)),
          field "include-dirs"         (fsep (map text unitIncludeDirs)),
          field "includes"             (fsep (map text unitIncludes)),
          field "depends"              (fsep (map ppr  unitDepends)),
          field "cc-options"           (fsep (map text unitCcOptions)),
          field "ld-options"           (fsep (map text unitLinkerOptions)),
          field "framework-dirs"       (fsep (map text unitExtDepFrameworkDirs)),
          field "frameworks"           (fsep (map text unitExtDepFrameworks)),
          field "haddock-interfaces"   (fsep (map text unitHaddockInterfaces)),
          field "haddock-html"         (fsep (map text unitHaddockHTMLs))
        ]
      where
        field name body = text name <> colon <+> nest 4 body

    -- | Make a `Unit` from a `UnitInfo`
    --
    -- If the unit is definite, make a `RealUnit` from `unitId` field.
    --
    -- If the unit is indefinite, make a `VirtUnit` from `unitInstanceOf` and
    -- `unitInstantiations` fields. Note that in this case we don't keep track of
    -- `unitId`. It can be retrieved later with "improvement", i.e. matching on
    -- `unitInstanceOf/unitInstantiations` fields (see Note [About units] in
    -- GHC.Unit).
    mkUnit :: UnitInfo -> Unit
    mkUnit p
       | unitIsIndefinite p = mkVirtUnit (unitInstanceOf p) (unitInstantiations p)
       | otherwise          = RealUnit (Definite (unitId p))

    -- | Create a UnitPprInfo from a UnitInfo
    mkUnitPprInfo :: GenUnitInfo u -> UnitPprInfo
    mkUnitPprInfo i = UnitPprInfo
       (unitPackageNameString i)
       (unitPackageVersion i)
       ((unpackFS . unPackageName) <$> unitComponentName i)