{-# 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

   , collectIncludeDirs
   , collectExtraCcOpts
   , collectLibraryDirs
   , collectFrameworks
   , collectFrameworksDirs
   , unitHsLibs
   )
where

#include "HsVersions.h"

import GHC.Prelude
import GHC.Platform.Ways

import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic

import GHC.Types.Unique

import GHC.Data.FastString
import qualified GHC.Data.ShortText as ST

import GHC.Unit.Module as Module
import GHC.Unit.Ppr
import GHC.Unit.Database

import GHC.Settings

import Data.Version
import Data.Bifunctor
import Data.List (isPrefixOf, stripPrefix)
import qualified Data.Set as Set


-- | 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))

-- | 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 -> Indefinite UnitKey
forall unit. unit -> Indefinite unit
Indefinite (ByteString -> UnitKey
mkUnitKey' ByteString
cid)
     mkVirtUnitKey' :: DbInstUnitId -> GenUnit UnitKey
mkVirtUnitKey' DbInstUnitId
i = case DbInstUnitId
i of
      DbInstUnitId ByteString
cid [(ByteString, DbModule)]
insts -> Indefinite UnitKey
-> [(ModuleName, GenModule (GenUnit UnitKey))] -> GenUnit UnitKey
forall u.
IsUnitId u =>
Indefinite u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
mkVirtUnit (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 :: IsUnitId v => (u -> v) -> GenUnitInfo u -> GenUnitInfo v
mapUnitInfo :: forall v u.
IsUnitId v =>
(u -> v) -> GenUnitInfo u -> GenUnitInfo v
mapUnitInfo u -> v
f = (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) -> GenUnit u -> GenUnit v
forall v u. IsUnitId v => (u -> v) -> GenUnit u -> GenUnit v
mapGenUnit u -> v
f)) -- instantiating modules

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)
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)

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 -> FilePath
unitPackageIdString GenUnitInfo u
pkg = FastString -> FilePath
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 -> FilePath
unitPackageNameString GenUnitInfo u
pkg = FastString -> FilePath
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
[(ModuleName, Maybe (GenModule (GenUnit UnitId)))]
[(ModuleName, GenModule (GenUnit UnitId))]
[(UnitId, ShortText)]
[ShortText]
[ModuleName]
[UnitId]
Maybe PackageName
Version
ShortText
Indefinite UnitId
UnitId
PackageId
PackageName
unitAbiDepends :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(uid, ShortText)]
unitAbiHash :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> ShortText
unitCcOptions :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
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
-> [ShortText]
unitExtDepFrameworks :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepLibsGhc :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepLibsSys :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitHaddockHTMLs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitHaddockInterfaces :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
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
-> [ShortText]
unitIncludeDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitIncludes :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
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
-> [ShortText]
unitLibraryDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDynDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLinkerOptions :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
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 :: [ShortText]
unitHaddockInterfaces :: [ShortText]
unitIncludeDirs :: [ShortText]
unitIncludes :: [ShortText]
unitCcOptions :: [ShortText]
unitLinkerOptions :: [ShortText]
unitExtDepFrameworkDirs :: [ShortText]
unitExtDepFrameworks :: [ShortText]
unitLibraryDynDirs :: [ShortText]
unitLibraryDirs :: [ShortText]
unitExtDepLibsGhc :: [ShortText]
unitExtDepLibsSys :: [ShortText]
unitLibraries :: [ShortText]
unitImportDirs :: [ShortText]
unitAbiDepends :: [(UnitId, ShortText)]
unitDepends :: [UnitId]
unitAbiHash :: ShortText
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 [
      FilePath -> SDoc -> SDoc
field FilePath
"name"                 (PackageName -> SDoc
forall a. Outputable a => a -> SDoc
ppr PackageName
unitPackageName),
      FilePath -> SDoc -> SDoc
field FilePath
"version"              (FilePath -> SDoc
text (Version -> FilePath
showVersion Version
unitPackageVersion)),
      FilePath -> SDoc -> SDoc
field FilePath
"id"                   (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
unitId),
      FilePath -> SDoc -> SDoc
field FilePath
"exposed"              (Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
unitIsExposed),
      FilePath -> SDoc -> SDoc
field FilePath
"exposed-modules"      ([(ModuleName, Maybe (GenModule (GenUnit UnitId)))] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [(ModuleName, Maybe (GenModule (GenUnit UnitId)))]
unitExposedModules),
      FilePath -> SDoc -> SDoc
field FilePath
"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)),
      FilePath -> SDoc -> SDoc
field FilePath
"trusted"              (Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
unitIsTrusted),
      FilePath -> SDoc -> SDoc
field FilePath
"import-dirs"          ([SDoc] -> SDoc
fsep ((ShortText -> SDoc) -> [ShortText] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SDoc
text (FilePath -> SDoc) -> (ShortText -> FilePath) -> ShortText -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) [ShortText]
unitImportDirs)),
      FilePath -> SDoc -> SDoc
field FilePath
"library-dirs"         ([SDoc] -> SDoc
fsep ((ShortText -> SDoc) -> [ShortText] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SDoc
text (FilePath -> SDoc) -> (ShortText -> FilePath) -> ShortText -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) [ShortText]
unitLibraryDirs)),
      FilePath -> SDoc -> SDoc
field FilePath
"dynamic-library-dirs" ([SDoc] -> SDoc
fsep ((ShortText -> SDoc) -> [ShortText] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SDoc
text (FilePath -> SDoc) -> (ShortText -> FilePath) -> ShortText -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) [ShortText]
unitLibraryDynDirs)),
      FilePath -> SDoc -> SDoc
field FilePath
"hs-libraries"         ([SDoc] -> SDoc
fsep ((ShortText -> SDoc) -> [ShortText] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SDoc
text (FilePath -> SDoc) -> (ShortText -> FilePath) -> ShortText -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) [ShortText]
unitLibraries)),
      FilePath -> SDoc -> SDoc
field FilePath
"extra-libraries"      ([SDoc] -> SDoc
fsep ((ShortText -> SDoc) -> [ShortText] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SDoc
text (FilePath -> SDoc) -> (ShortText -> FilePath) -> ShortText -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) [ShortText]
unitExtDepLibsSys)),
      FilePath -> SDoc -> SDoc
field FilePath
"extra-ghci-libraries" ([SDoc] -> SDoc
fsep ((ShortText -> SDoc) -> [ShortText] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SDoc
text (FilePath -> SDoc) -> (ShortText -> FilePath) -> ShortText -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) [ShortText]
unitExtDepLibsGhc)),
      FilePath -> SDoc -> SDoc
field FilePath
"include-dirs"         ([SDoc] -> SDoc
fsep ((ShortText -> SDoc) -> [ShortText] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SDoc
text (FilePath -> SDoc) -> (ShortText -> FilePath) -> ShortText -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) [ShortText]
unitIncludeDirs)),
      FilePath -> SDoc -> SDoc
field FilePath
"includes"             ([SDoc] -> SDoc
fsep ((ShortText -> SDoc) -> [ShortText] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SDoc
text (FilePath -> SDoc) -> (ShortText -> FilePath) -> ShortText -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) [ShortText]
unitIncludes)),
      FilePath -> SDoc -> SDoc
field FilePath
"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)),
      FilePath -> SDoc -> SDoc
field FilePath
"cc-options"           ([SDoc] -> SDoc
fsep ((ShortText -> SDoc) -> [ShortText] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SDoc
text (FilePath -> SDoc) -> (ShortText -> FilePath) -> ShortText -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) [ShortText]
unitCcOptions)),
      FilePath -> SDoc -> SDoc
field FilePath
"ld-options"           ([SDoc] -> SDoc
fsep ((ShortText -> SDoc) -> [ShortText] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SDoc
text (FilePath -> SDoc) -> (ShortText -> FilePath) -> ShortText -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) [ShortText]
unitLinkerOptions)),
      FilePath -> SDoc -> SDoc
field FilePath
"framework-dirs"       ([SDoc] -> SDoc
fsep ((ShortText -> SDoc) -> [ShortText] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SDoc
text (FilePath -> SDoc) -> (ShortText -> FilePath) -> ShortText -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) [ShortText]
unitExtDepFrameworkDirs)),
      FilePath -> SDoc -> SDoc
field FilePath
"frameworks"           ([SDoc] -> SDoc
fsep ((ShortText -> SDoc) -> [ShortText] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SDoc
text (FilePath -> SDoc) -> (ShortText -> FilePath) -> ShortText -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) [ShortText]
unitExtDepFrameworks)),
      FilePath -> SDoc -> SDoc
field FilePath
"haddock-interfaces"   ([SDoc] -> SDoc
fsep ((ShortText -> SDoc) -> [ShortText] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SDoc
text (FilePath -> SDoc) -> (ShortText -> FilePath) -> ShortText -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) [ShortText]
unitHaddockInterfaces)),
      FilePath -> SDoc -> SDoc
field FilePath
"haddock-html"         ([SDoc] -> SDoc
fsep ((ShortText -> SDoc) -> [ShortText] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SDoc
text (FilePath -> SDoc) -> (ShortText -> FilePath) -> ShortText -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) [ShortText]
unitHaddockHTMLs))
    ]
  where
    field :: FilePath -> SDoc -> SDoc
field FilePath
name SDoc
body = FilePath -> SDoc
text FilePath
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
forall u.
IsUnitId u =>
Indefinite u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
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 :: (u -> FastString) -> GenUnitInfo u -> UnitPprInfo
mkUnitPprInfo :: forall u. (u -> FastString) -> GenUnitInfo u -> UnitPprInfo
mkUnitPprInfo u -> FastString
ufs GenUnitInfo u
i = FastString -> FilePath -> Version -> Maybe FilePath -> UnitPprInfo
UnitPprInfo
   (u -> FastString
ufs (GenUnitInfo u -> u
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId GenUnitInfo u
i))
   (GenUnitInfo u -> FilePath
forall u. GenUnitInfo u -> FilePath
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 -> FilePath
unpackFS (FastString -> FilePath)
-> (PackageName -> FastString) -> PackageName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> FastString
unPackageName) (PackageName -> FilePath) -> Maybe PackageName -> Maybe FilePath
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)

-- | Find all the include directories in the given units
collectIncludeDirs :: [UnitInfo] -> [FilePath]
collectIncludeDirs :: [UnitInfo] -> [FilePath]
collectIncludeDirs [UnitInfo]
ps = (ShortText -> FilePath) -> [ShortText] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShortText -> FilePath
ST.unpack ([ShortText] -> [FilePath]) -> [ShortText] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [ShortText] -> [ShortText]
forall a. Ord a => [a] -> [a]
ordNub ((ShortText -> Bool) -> [ShortText] -> [ShortText]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ShortText -> Bool) -> ShortText -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Bool
ST.null) ((UnitInfo -> [ShortText]) -> [UnitInfo] -> [ShortText]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap UnitInfo -> [ShortText]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitIncludeDirs [UnitInfo]
ps))

-- | Find all the C-compiler options in the given units
collectExtraCcOpts :: [UnitInfo] -> [String]
collectExtraCcOpts :: [UnitInfo] -> [FilePath]
collectExtraCcOpts [UnitInfo]
ps = (ShortText -> FilePath) -> [ShortText] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShortText -> FilePath
ST.unpack ((UnitInfo -> [ShortText]) -> [UnitInfo] -> [ShortText]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap UnitInfo -> [ShortText]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitCcOptions [UnitInfo]
ps)

-- | Find all the library directories in the given units for the given ways
collectLibraryDirs :: Ways -> [UnitInfo] -> [FilePath]
collectLibraryDirs :: Ways -> [UnitInfo] -> [FilePath]
collectLibraryDirs Ways
ws = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
ordNub ([FilePath] -> [FilePath])
-> ([UnitInfo] -> [FilePath]) -> [UnitInfo] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
forall (f :: * -> *) a. Foldable f => f a -> Bool
notNull ([FilePath] -> [FilePath])
-> ([UnitInfo] -> [FilePath]) -> [UnitInfo] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInfo -> [FilePath]) -> [UnitInfo] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Ways -> UnitInfo -> [FilePath]
libraryDirsForWay Ways
ws)

-- | Find all the frameworks in the given units
collectFrameworks :: [UnitInfo] -> [String]
collectFrameworks :: [UnitInfo] -> [FilePath]
collectFrameworks [UnitInfo]
ps = (ShortText -> FilePath) -> [ShortText] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShortText -> FilePath
ST.unpack ((UnitInfo -> [ShortText]) -> [UnitInfo] -> [ShortText]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap UnitInfo -> [ShortText]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepFrameworks [UnitInfo]
ps)

-- | Find all the package framework paths in these and the preload packages
collectFrameworksDirs :: [UnitInfo] -> [String]
collectFrameworksDirs :: [UnitInfo] -> [FilePath]
collectFrameworksDirs [UnitInfo]
ps = (ShortText -> FilePath) -> [ShortText] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShortText -> FilePath
ST.unpack ([ShortText] -> [ShortText]
forall a. Ord a => [a] -> [a]
ordNub ((ShortText -> Bool) -> [ShortText] -> [ShortText]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ShortText -> Bool) -> ShortText -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Bool
ST.null) ((UnitInfo -> [ShortText]) -> [UnitInfo] -> [ShortText]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap UnitInfo -> [ShortText]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepFrameworkDirs [UnitInfo]
ps)))

-- | Either the 'unitLibraryDirs' or 'unitLibraryDynDirs' as appropriate for the way.
libraryDirsForWay :: Ways -> UnitInfo -> [String]
libraryDirsForWay :: Ways -> UnitInfo -> [FilePath]
libraryDirsForWay Ways
ws
  | Way
WayDyn Way -> Ways -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Ways
ws = (ShortText -> FilePath) -> [ShortText] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShortText -> FilePath
ST.unpack ([ShortText] -> [FilePath])
-> (UnitInfo -> [ShortText]) -> UnitInfo -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> [ShortText]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDynDirs
  | Bool
otherwise        = (ShortText -> FilePath) -> [ShortText] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ShortText -> FilePath
ST.unpack ([ShortText] -> [FilePath])
-> (UnitInfo -> [ShortText]) -> UnitInfo -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> [ShortText]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDirs

unitHsLibs :: GhcNameVersion -> Ways -> UnitInfo -> [String]
unitHsLibs :: GhcNameVersion -> Ways -> UnitInfo -> [FilePath]
unitHsLibs GhcNameVersion
namever Ways
ways0 UnitInfo
p = (ShortText -> FilePath) -> [ShortText] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath
mkDynName (FilePath -> FilePath)
-> (ShortText -> FilePath) -> ShortText -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
addSuffix (FilePath -> FilePath)
-> (ShortText -> FilePath) -> ShortText -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> FilePath
ST.unpack) (UnitInfo -> [ShortText]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraries UnitInfo
p)
  where
        ways1 :: Ways
ways1 = (Way -> Bool) -> Ways -> Ways
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Way -> Way -> Bool
forall a. Eq a => a -> a -> Bool
/= Way
WayDyn) Ways
ways0
        -- the name of a shared library is libHSfoo-ghc<version>.so
        -- we leave out the _dyn, because it is superfluous

        -- debug and profiled RTSs include support for -eventlog
        ways2 :: Ways
ways2 | Way
WayDebug Way -> Ways -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Ways
ways1 Bool -> Bool -> Bool
|| Way
WayProf Way -> Ways -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Ways
ways1
              = (Way -> Bool) -> Ways -> Ways
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Way -> Way -> Bool
forall a. Eq a => a -> a -> Bool
/= Way
WayTracing) Ways
ways1
              | Bool
otherwise
              = Ways
ways1

        tag :: FilePath
tag     = Ways -> FilePath
waysTag (Ways -> Ways
fullWays Ways
ways2)
        rts_tag :: FilePath
rts_tag = Ways -> FilePath
waysTag Ways
ways2

        mkDynName :: FilePath -> FilePath
mkDynName FilePath
x
         | Bool -> Bool
not (Ways
ways0 Ways -> Way -> Bool
`hasWay` Way
WayDyn) = FilePath
x
         | FilePath
"HS" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
x         = FilePath
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ GhcNameVersion -> FilePath
dynLibSuffix GhcNameVersion
namever
           -- For non-Haskell libraries, we use the name "Cfoo". The .a
           -- file is libCfoo.a, and the .so is libfoo.so. That way the
           -- linker knows what we mean for the vanilla (-lCfoo) and dyn
           -- (-lfoo) ways. We therefore need to strip the 'C' off here.
         | Just FilePath
x' <- FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePath
"C" FilePath
x = FilePath
x'
         | Bool
otherwise
            = FilePath -> FilePath
forall a. FilePath -> a
panic (FilePath
"Don't understand library name " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x)

        -- Add _thr and other rts suffixes to packages named
        -- `rts` or `rts-1.0`. Why both?  Traditionally the rts
        -- package is called `rts` only.  However the tooling
        -- usually expects a package name to have a version.
        -- As such we will gradually move towards the `rts-1.0`
        -- package name, at which point the `rts` package name
        -- will eventually be unused.
        --
        -- This change elevates the need to add custom hooks
        -- and handling specifically for the `rts` package for
        -- example in ghc-cabal.
        addSuffix :: FilePath -> FilePath
addSuffix rts :: FilePath
rts@FilePath
"HSrts"       = FilePath
rts       FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath
expandTag FilePath
rts_tag)
        addSuffix rts :: FilePath
rts@FilePath
"HSrts-1.0.2" = FilePath
rts       FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath
expandTag FilePath
rts_tag)
        addSuffix FilePath
other_lib         = FilePath
other_lib FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath
expandTag FilePath
tag)

        expandTag :: FilePath -> FilePath
expandTag FilePath
t | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
t = FilePath
""
                    | Bool
otherwise = Char
'_'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
t