{-# 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 -> FastString
unitKeyFS (UnitKey FastString
fs) = FastString
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 :: DbUnitInfo -> UnitKeyInfo
mkUnitKeyInfo = (ByteString -> UnitKey)
-> (ByteString -> Indefinite UnitKey)
-> (ByteString -> PackageId)
-> (ByteString -> PackageName)
-> (ByteString -> ModuleName)
-> (DbModule -> GenModule (GenUnit UnitKey))
-> DbUnitInfo
-> UnitKeyInfo
forall uid1 uid2 cid1 cid2 srcpkg1 srcpkg2 srcpkgname1 srcpkgname2
       modname1 modname2 mod1 mod2.
(uid1 -> uid2)
-> (cid1 -> cid2)
-> (srcpkg1 -> srcpkg2)
-> (srcpkgname1 -> srcpkgname2)
-> (modname1 -> modname2)
-> (mod1 -> mod2)
-> GenericUnitInfo cid1 srcpkg1 srcpkgname1 uid1 modname1 mod1
-> GenericUnitInfo cid2 srcpkg2 srcpkgname2 uid2 modname2 mod2
mapGenericUnitInfo
   ByteString -> UnitKey
mkUnitKey'
   ByteString -> Indefinite UnitKey
mkIndefUnitKey'
   ByteString -> PackageId
mkPackageIdentifier'
   ByteString -> PackageName
mkPackageName'
   ByteString -> ModuleName
mkModuleName'
   DbModule -> GenModule (GenUnit UnitKey)
mkModule'
   where
     mkPackageIdentifier' :: ByteString -> PackageId
mkPackageIdentifier' = FastString -> PackageId
PackageId      (FastString -> PackageId)
-> (ByteString -> FastString) -> ByteString -> PackageId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FastString
mkFastStringByteString
     mkPackageName' :: ByteString -> PackageName
mkPackageName'       = FastString -> PackageName
PackageName    (FastString -> PackageName)
-> (ByteString -> FastString) -> ByteString -> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FastString
mkFastStringByteString
     mkUnitKey' :: ByteString -> UnitKey
mkUnitKey'           = FastString -> UnitKey
UnitKey        (FastString -> UnitKey)
-> (ByteString -> FastString) -> ByteString -> UnitKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FastString
mkFastStringByteString
     mkModuleName' :: ByteString -> ModuleName
mkModuleName'        = FastString -> ModuleName
mkModuleNameFS (FastString -> ModuleName)
-> (ByteString -> FastString) -> ByteString -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FastString
mkFastStringByteString
     mkIndefUnitKey' :: ByteString -> Indefinite UnitKey
mkIndefUnitKey' ByteString
cid  = UnitKey -> Maybe UnitPprInfo -> Indefinite UnitKey
forall unit. unit -> Maybe UnitPprInfo -> Indefinite unit
Indefinite (ByteString -> UnitKey
mkUnitKey' ByteString
cid) Maybe UnitPprInfo
forall a. Maybe a
Nothing
     mkVirtUnitKey' :: DbInstUnitId -> GenUnit UnitKey
mkVirtUnitKey' DbInstUnitId
i = case DbInstUnitId
i of
      DbInstUnitId ByteString
cid [(ByteString, DbModule)]
insts -> (UnitKey -> FastString)
-> Indefinite UnitKey
-> [(ModuleName, GenModule (GenUnit UnitKey))]
-> GenUnit UnitKey
forall unit.
(unit -> FastString)
-> Indefinite unit
-> [(ModuleName, GenModule (GenUnit unit))]
-> GenUnit unit
mkGenVirtUnit UnitKey -> FastString
unitKeyFS (ByteString -> Indefinite UnitKey
mkIndefUnitKey' ByteString
cid) (((ByteString, DbModule)
 -> (ModuleName, GenModule (GenUnit UnitKey)))
-> [(ByteString, DbModule)]
-> [(ModuleName, GenModule (GenUnit UnitKey))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> ModuleName)
-> (DbModule -> GenModule (GenUnit UnitKey))
-> (ByteString, DbModule)
-> (ModuleName, GenModule (GenUnit UnitKey))
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ByteString -> ModuleName
mkModuleName' DbModule -> GenModule (GenUnit UnitKey)
mkModule') [(ByteString, DbModule)]
insts)
      DbUnitId ByteString
uid           -> Definite UnitKey -> GenUnit UnitKey
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitKey -> Definite UnitKey
forall unit. unit -> Definite unit
Definite (ByteString -> UnitKey
mkUnitKey' ByteString
uid))
     mkModule' :: DbModule -> GenModule (GenUnit UnitKey)
mkModule' DbModule
m = case DbModule
m of
       DbModule DbInstUnitId
uid ByteString
n -> GenUnit UnitKey -> ModuleName -> GenModule (GenUnit UnitKey)
forall u. u -> ModuleName -> GenModule u
mkModule (DbInstUnitId -> GenUnit UnitKey
mkVirtUnitKey' DbInstUnitId
uid) (ByteString -> ModuleName
mkModuleName' ByteString
n)
       DbModuleVar  ByteString
n -> ModuleName -> GenModule (GenUnit UnitKey)
forall u. ModuleName -> GenModule (GenUnit u)
mkHoleModule (ByteString -> ModuleName
mkModuleName' ByteString
n)

-- | Map over the unit parameter
mapUnitInfo :: (u -> v) -> (v -> FastString) -> GenUnitInfo u -> GenUnitInfo v
mapUnitInfo :: forall u v.
(u -> v) -> (v -> FastString) -> GenUnitInfo u -> GenUnitInfo v
mapUnitInfo u -> v
f v -> FastString
gunitFS = (u -> v)
-> (Indefinite u -> Indefinite v)
-> (PackageId -> PackageId)
-> (PackageName -> PackageName)
-> (ModuleName -> ModuleName)
-> (GenModule (GenUnit u) -> GenModule (GenUnit v))
-> GenericUnitInfo
     (Indefinite u)
     PackageId
     PackageName
     u
     ModuleName
     (GenModule (GenUnit u))
-> GenericUnitInfo
     (Indefinite v)
     PackageId
     PackageName
     v
     ModuleName
     (GenModule (GenUnit v))
forall uid1 uid2 cid1 cid2 srcpkg1 srcpkg2 srcpkgname1 srcpkgname2
       modname1 modname2 mod1 mod2.
(uid1 -> uid2)
-> (cid1 -> cid2)
-> (srcpkg1 -> srcpkg2)
-> (srcpkgname1 -> srcpkgname2)
-> (modname1 -> modname2)
-> (mod1 -> mod2)
-> GenericUnitInfo cid1 srcpkg1 srcpkgname1 uid1 modname1 mod1
-> GenericUnitInfo cid2 srcpkg2 srcpkgname2 uid2 modname2 mod2
mapGenericUnitInfo
   u -> v
f         -- unit identifier
   ((u -> v) -> Indefinite u -> Indefinite v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap u -> v
f)  -- indefinite unit identifier
   PackageId -> PackageId
forall a. a -> a
id        -- package identifier
   PackageName -> PackageName
forall a. a -> a
id        -- package name
   ModuleName -> ModuleName
forall a. a -> a
id        -- module name
   ((GenUnit u -> GenUnit v)
-> GenModule (GenUnit u) -> GenModule (GenUnit v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((u -> v) -> (v -> FastString) -> GenUnit u -> GenUnit v
forall u v. (u -> v) -> (v -> FastString) -> GenUnit u -> GenUnit v
mapGenUnit u -> v
f v -> FastString
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 (PackageId -> PackageId -> Bool
(PackageId -> PackageId -> Bool)
-> (PackageId -> PackageId -> Bool) -> Eq PackageId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageId -> PackageId -> Bool
$c/= :: PackageId -> PackageId -> Bool
== :: PackageId -> PackageId -> Bool
$c== :: PackageId -> PackageId -> Bool
Eq, Eq PackageId
Eq PackageId
-> (PackageId -> PackageId -> Ordering)
-> (PackageId -> PackageId -> Bool)
-> (PackageId -> PackageId -> Bool)
-> (PackageId -> PackageId -> Bool)
-> (PackageId -> PackageId -> Bool)
-> (PackageId -> PackageId -> PackageId)
-> (PackageId -> PackageId -> PackageId)
-> Ord PackageId
PackageId -> PackageId -> Bool
PackageId -> PackageId -> Ordering
PackageId -> PackageId -> PackageId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageId -> PackageId -> PackageId
$cmin :: PackageId -> PackageId -> PackageId
max :: PackageId -> PackageId -> PackageId
$cmax :: PackageId -> PackageId -> PackageId
>= :: PackageId -> PackageId -> Bool
$c>= :: PackageId -> PackageId -> Bool
> :: PackageId -> PackageId -> Bool
$c> :: PackageId -> PackageId -> Bool
<= :: PackageId -> PackageId -> Bool
$c<= :: PackageId -> PackageId -> Bool
< :: PackageId -> PackageId -> Bool
$c< :: PackageId -> PackageId -> Bool
compare :: PackageId -> PackageId -> Ordering
$ccompare :: PackageId -> PackageId -> Ordering
Ord)
newtype PackageName = PackageName
   { PackageName -> FastString
unPackageName :: FastString
   }
   deriving (PackageName -> PackageName -> Bool
(PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> Bool) -> Eq PackageName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageName -> PackageName -> Bool
$c/= :: PackageName -> PackageName -> Bool
== :: PackageName -> PackageName -> Bool
$c== :: PackageName -> PackageName -> Bool
Eq, Eq PackageName
Eq PackageName
-> (PackageName -> PackageName -> Ordering)
-> (PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> PackageName)
-> (PackageName -> PackageName -> PackageName)
-> Ord PackageName
PackageName -> PackageName -> Bool
PackageName -> PackageName -> Ordering
PackageName -> PackageName -> PackageName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageName -> PackageName -> PackageName
$cmin :: PackageName -> PackageName -> PackageName
max :: PackageName -> PackageName -> PackageName
$cmax :: PackageName -> PackageName -> PackageName
>= :: PackageName -> PackageName -> Bool
$c>= :: PackageName -> PackageName -> Bool
> :: PackageName -> PackageName -> Bool
$c> :: PackageName -> PackageName -> Bool
<= :: PackageName -> PackageName -> Bool
$c<= :: PackageName -> PackageName -> Bool
< :: PackageName -> PackageName -> Bool
$c< :: PackageName -> PackageName -> Bool
compare :: PackageName -> PackageName -> Ordering
$ccompare :: PackageName -> PackageName -> Ordering
Ord)

instance Uniquable PackageId where
  getUnique :: PackageId -> Unique
getUnique (PackageId FastString
n) = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
n

instance Uniquable PackageName where
  getUnique :: PackageName -> Unique
getUnique (PackageName FastString
n) = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
n

instance Outputable PackageId where
  ppr :: PackageId -> SDoc
ppr (PackageId FastString
str) = FastString -> SDoc
ftext FastString
str

instance Outputable PackageName where
  ppr :: PackageName -> SDoc
ppr (PackageName FastString
str) = FastString -> SDoc
ftext FastString
str

unitPackageIdString :: GenUnitInfo u -> String
unitPackageIdString :: forall u. GenUnitInfo u -> String
unitPackageIdString GenUnitInfo u
pkg = FastString -> String
unpackFS FastString
str
  where
    PackageId FastString
str = GenUnitInfo u -> PackageId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgid
unitPackageId GenUnitInfo u
pkg

unitPackageNameString :: GenUnitInfo u -> String
unitPackageNameString :: forall u. GenUnitInfo u -> String
unitPackageNameString GenUnitInfo u
pkg = FastString -> String
unpackFS FastString
str
  where
    PackageName FastString
str = GenUnitInfo u -> PackageName
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageName GenUnitInfo u
pkg

pprUnitInfo :: UnitInfo -> SDoc
pprUnitInfo :: UnitInfo -> SDoc
pprUnitInfo GenericUnitInfo {Bool
String
[String]
[(ModuleName, Maybe (GenModule (GenUnit UnitId)))]
[(ModuleName, GenModule (GenUnit UnitId))]
[(UnitId, String)]
[ModuleName]
[UnitId]
Maybe PackageName
Version
Indefinite UnitId
UnitId
PackageId
PackageName
unitAbiDepends :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(uid, String)]
unitAbiHash :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> String
unitCcOptions :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [String]
unitComponentName :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Maybe srcpkgname
unitDepends :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [uid]
unitExposedModules :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, Maybe mod)]
unitExtDepFrameworkDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [String]
unitExtDepFrameworks :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [String]
unitExtDepLibsGhc :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [String]
unitExtDepLibsSys :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [String]
unitHaddockHTMLs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [String]
unitHaddockInterfaces :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [String]
unitHiddenModules :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [modulename]
unitId :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitImportDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [String]
unitIncludeDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [String]
unitIncludes :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [String]
unitInstanceOf :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> compid
unitInstantiations :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, mod)]
unitIsExposed :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitIsIndefinite :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitIsTrusted :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitLibraries :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [String]
unitLibraryDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [String]
unitLibraryDynDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [String]
unitLinkerOptions :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [String]
unitPackageVersion :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Version
unitIsTrusted :: Bool
unitIsExposed :: Bool
unitIsIndefinite :: Bool
unitHiddenModules :: [ModuleName]
unitExposedModules :: [(ModuleName, Maybe (GenModule (GenUnit UnitId)))]
unitHaddockHTMLs :: [String]
unitHaddockInterfaces :: [String]
unitIncludeDirs :: [String]
unitIncludes :: [String]
unitCcOptions :: [String]
unitLinkerOptions :: [String]
unitExtDepFrameworkDirs :: [String]
unitExtDepFrameworks :: [String]
unitLibraryDynDirs :: [String]
unitLibraryDirs :: [String]
unitExtDepLibsGhc :: [String]
unitExtDepLibsSys :: [String]
unitLibraries :: [String]
unitImportDirs :: [String]
unitAbiDepends :: [(UnitId, String)]
unitDepends :: [UnitId]
unitAbiHash :: String
unitComponentName :: Maybe PackageName
unitPackageVersion :: Version
unitPackageName :: PackageName
unitPackageId :: PackageId
unitInstantiations :: [(ModuleName, GenModule (GenUnit UnitId))]
unitInstanceOf :: Indefinite UnitId
unitId :: UnitId
unitPackageName :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageId :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgid
..} =
    [SDoc] -> SDoc
vcat [
      String -> SDoc -> SDoc
field String
"name"                 (PackageName -> SDoc
forall a. Outputable a => a -> SDoc
ppr PackageName
unitPackageName),
      String -> SDoc -> SDoc
field String
"version"              (String -> SDoc
text (Version -> String
showVersion Version
unitPackageVersion)),
      String -> SDoc -> SDoc
field String
"id"                   (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
unitId),
      String -> SDoc -> SDoc
field String
"exposed"              (Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
unitIsExposed),
      String -> SDoc -> SDoc
field String
"exposed-modules"      ([(ModuleName, Maybe (GenModule (GenUnit UnitId)))] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [(ModuleName, Maybe (GenModule (GenUnit UnitId)))]
unitExposedModules),
      String -> SDoc -> SDoc
field String
"hidden-modules"       ([SDoc] -> SDoc
fsep ((ModuleName -> SDoc) -> [ModuleName] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ModuleName]
unitHiddenModules)),
      String -> SDoc -> SDoc
field String
"trusted"              (Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
unitIsTrusted),
      String -> SDoc -> SDoc
field String
"import-dirs"          ([SDoc] -> SDoc
fsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
unitImportDirs)),
      String -> SDoc -> SDoc
field String
"library-dirs"         ([SDoc] -> SDoc
fsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
unitLibraryDirs)),
      String -> SDoc -> SDoc
field String
"dynamic-library-dirs" ([SDoc] -> SDoc
fsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
unitLibraryDynDirs)),
      String -> SDoc -> SDoc
field String
"hs-libraries"         ([SDoc] -> SDoc
fsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
unitLibraries)),
      String -> SDoc -> SDoc
field String
"extra-libraries"      ([SDoc] -> SDoc
fsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
unitExtDepLibsSys)),
      String -> SDoc -> SDoc
field String
"extra-ghci-libraries" ([SDoc] -> SDoc
fsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
unitExtDepLibsGhc)),
      String -> SDoc -> SDoc
field String
"include-dirs"         ([SDoc] -> SDoc
fsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
unitIncludeDirs)),
      String -> SDoc -> SDoc
field String
"includes"             ([SDoc] -> SDoc
fsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
unitIncludes)),
      String -> SDoc -> SDoc
field String
"depends"              ([SDoc] -> SDoc
fsep ((UnitId -> SDoc) -> [UnitId] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr  [UnitId]
unitDepends)),
      String -> SDoc -> SDoc
field String
"cc-options"           ([SDoc] -> SDoc
fsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
unitCcOptions)),
      String -> SDoc -> SDoc
field String
"ld-options"           ([SDoc] -> SDoc
fsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
unitLinkerOptions)),
      String -> SDoc -> SDoc
field String
"framework-dirs"       ([SDoc] -> SDoc
fsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
unitExtDepFrameworkDirs)),
      String -> SDoc -> SDoc
field String
"frameworks"           ([SDoc] -> SDoc
fsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
unitExtDepFrameworks)),
      String -> SDoc -> SDoc
field String
"haddock-interfaces"   ([SDoc] -> SDoc
fsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
unitHaddockInterfaces)),
      String -> SDoc -> SDoc
field String
"haddock-html"         ([SDoc] -> SDoc
fsep ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
unitHaddockHTMLs))
    ]
  where
    field :: String -> SDoc -> SDoc
field String
name SDoc
body = String -> SDoc
text String
name SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<+> Int -> SDoc -> SDoc
nest Int
4 SDoc
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 :: UnitInfo -> GenUnit UnitId
mkUnit UnitInfo
p
   | UnitInfo -> Bool
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitIsIndefinite UnitInfo
p = Indefinite UnitId
-> [(ModuleName, GenModule (GenUnit UnitId))] -> GenUnit UnitId
mkVirtUnit (UnitInfo -> Indefinite UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> compid
unitInstanceOf UnitInfo
p) (UnitInfo -> [(ModuleName, GenModule (GenUnit UnitId))]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, mod)]
unitInstantiations UnitInfo
p)
   | Bool
otherwise          = Definite UnitId -> GenUnit UnitId
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite (UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId UnitInfo
p))

-- | Create a UnitPprInfo from a UnitInfo
mkUnitPprInfo :: GenUnitInfo u -> UnitPprInfo
mkUnitPprInfo :: forall u. GenUnitInfo u -> UnitPprInfo
mkUnitPprInfo GenUnitInfo u
i = String -> Version -> Maybe String -> UnitPprInfo
UnitPprInfo
   (GenUnitInfo u -> String
forall u. GenUnitInfo u -> String
unitPackageNameString GenUnitInfo u
i)
   (GenUnitInfo u -> Version
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Version
unitPackageVersion GenUnitInfo u
i)
   ((FastString -> String
unpackFS (FastString -> String)
-> (PackageName -> FastString) -> PackageName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> FastString
unPackageName) (PackageName -> String) -> Maybe PackageName -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenUnitInfo u -> Maybe PackageName
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Maybe srcpkgname
unitComponentName GenUnitInfo u
i)