module GHC.Linker.Unit
( collectLinkOpts
, collectArchives
, getUnitLinkOpts
, getLibs
)
where
import GHC.Prelude
import GHC.Platform.Ways
import GHC.Unit.Types
import GHC.Unit.Info
import GHC.Unit.State
import GHC.Unit.Env
import GHC.Utils.Misc
import qualified GHC.Data.ShortText as ST
import GHC.Driver.Session
import Control.Monad
import System.Directory
import System.FilePath
getUnitLinkOpts :: DynFlags -> UnitEnv -> [UnitId] -> IO ([String], [String], [String])
getUnitLinkOpts :: DynFlags
-> UnitEnv -> [UnitId] -> IO ([[Char]], [[Char]], [[Char]])
getUnitLinkOpts DynFlags
dflags UnitEnv
unit_env [UnitId]
pkgs = do
[UnitInfo]
ps <- forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr forall a b. (a -> b) -> a -> b
$ UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' UnitEnv
unit_env [UnitId]
pkgs
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags -> [UnitInfo] -> ([[Char]], [[Char]], [[Char]])
collectLinkOpts DynFlags
dflags [UnitInfo]
ps)
collectLinkOpts :: DynFlags -> [UnitInfo] -> ([String], [String], [String])
collectLinkOpts :: DynFlags -> [UnitInfo] -> ([[Char]], [[Char]], [[Char]])
collectLinkOpts DynFlags
dflags [UnitInfo]
ps =
(
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-l" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcNameVersion -> Ways -> UnitInfo -> [[Char]]
unitHsLibs (DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags) (DynFlags -> Ways
ways DynFlags
dflags)) [UnitInfo]
ps,
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-l" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ShortText -> [Char]
ST.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepLibsSys) [UnitInfo]
ps,
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map ShortText -> [Char]
ST.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLinkerOptions) [UnitInfo]
ps
)
collectArchives :: DynFlags -> UnitInfo -> IO [FilePath]
collectArchives :: DynFlags -> UnitInfo -> IO [[Char]]
collectArchives DynFlags
dflags UnitInfo
pc =
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
doesFileExist [ [Char]
searchPath [Char] -> [Char] -> [Char]
</> ([Char]
"lib" forall a. [a] -> [a] -> [a]
++ [Char]
lib forall a. [a] -> [a] -> [a]
++ [Char]
".a")
| [Char]
searchPath <- [[Char]]
searchPaths
, [Char]
lib <- [[Char]]
libs ]
where searchPaths :: [[Char]]
searchPaths = forall a. Ord a => [a] -> [a]
ordNub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall (f :: * -> *) a. Foldable f => f a -> Bool
notNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ways -> UnitInfo -> [[Char]]
libraryDirsForWay (DynFlags -> Ways
ways DynFlags
dflags) forall a b. (a -> b) -> a -> b
$ UnitInfo
pc
libs :: [[Char]]
libs = GhcNameVersion -> Ways -> UnitInfo -> [[Char]]
unitHsLibs (DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags) (DynFlags -> Ways
ways DynFlags
dflags) UnitInfo
pc forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map ShortText -> [Char]
ST.unpack (forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepLibsSys UnitInfo
pc)
libraryDirsForWay :: Ways -> UnitInfo -> [String]
libraryDirsForWay :: Ways -> UnitInfo -> [[Char]]
libraryDirsForWay Ways
ws
| Way
WayDyn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Ways
ws = forall a b. (a -> b) -> [a] -> [b]
map ShortText -> [Char]
ST.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDynDirs
| Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map ShortText -> [Char]
ST.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDirs
getLibs :: DynFlags -> UnitEnv -> [UnitId] -> IO [(String,String)]
getLibs :: DynFlags -> UnitEnv -> [UnitId] -> IO [([Char], [Char])]
getLibs DynFlags
dflags UnitEnv
unit_env [UnitId]
pkgs = do
[UnitInfo]
ps <- forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr forall a b. (a -> b) -> a -> b
$ UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' UnitEnv
unit_env [UnitId]
pkgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [UnitInfo]
ps forall a b. (a -> b) -> a -> b
$ \UnitInfo
p -> do
let candidates :: [([Char], [Char])]
candidates = [ ([Char]
l [Char] -> [Char] -> [Char]
</> [Char]
f, [Char]
f) | [Char]
l <- Ways -> [UnitInfo] -> [[Char]]
collectLibraryDirs (DynFlags -> Ways
ways DynFlags
dflags) [UnitInfo
p]
, [Char]
f <- (\[Char]
n -> [Char]
"lib" forall a. [a] -> [a] -> [a]
++ [Char]
n forall a. [a] -> [a] -> [a]
++ [Char]
".a") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcNameVersion -> Ways -> UnitInfo -> [[Char]]
unitHsLibs (DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags) (DynFlags -> Ways
ways DynFlags
dflags) UnitInfo
p ]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ([Char] -> IO Bool
doesFileExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [([Char], [Char])]
candidates