-- | Linking Haskell units
module GHC.Linker.Unit
   ( UnitLinkOpts (..)
   , 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.Settings

import Control.Monad
import System.Directory
import System.FilePath

-- | Linker flags collected from units
data UnitLinkOpts = UnitLinkOpts
  { UnitLinkOpts -> [[Char]]
hsLibs     :: [String] -- ^ Haskell libraries (as a list of "-lHSfoo...")
  , UnitLinkOpts -> [[Char]]
extraLibs  :: [String] -- ^ External libraries (as a list of "-lfoo...")
  , UnitLinkOpts -> [[Char]]
otherFlags :: [String] -- ^ Extra linker options
  }
  deriving (Int -> UnitLinkOpts -> ShowS
[UnitLinkOpts] -> ShowS
UnitLinkOpts -> [Char]
(Int -> UnitLinkOpts -> ShowS)
-> (UnitLinkOpts -> [Char])
-> ([UnitLinkOpts] -> ShowS)
-> Show UnitLinkOpts
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnitLinkOpts -> ShowS
showsPrec :: Int -> UnitLinkOpts -> ShowS
$cshow :: UnitLinkOpts -> [Char]
show :: UnitLinkOpts -> [Char]
$cshowList :: [UnitLinkOpts] -> ShowS
showList :: [UnitLinkOpts] -> ShowS
Show)

-- | Find all the link options in these and the preload packages,
-- returning (package hs lib options, extra library options, other flags)
getUnitLinkOpts :: GhcNameVersion -> Ways -> UnitEnv -> [UnitId] -> IO UnitLinkOpts
getUnitLinkOpts :: GhcNameVersion -> Ways -> UnitEnv -> [UnitId] -> IO UnitLinkOpts
getUnitLinkOpts GhcNameVersion
namever Ways
ways UnitEnv
unit_env [UnitId]
pkgs = do
    ps <- MaybeErr UnitErr [UnitInfo] -> IO [UnitInfo]
forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr (MaybeErr UnitErr [UnitInfo] -> IO [UnitInfo])
-> MaybeErr UnitErr [UnitInfo] -> IO [UnitInfo]
forall a b. (a -> b) -> a -> b
$ UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' UnitEnv
unit_env [UnitId]
pkgs
    return (collectLinkOpts namever ways ps)

collectLinkOpts :: GhcNameVersion -> Ways -> [UnitInfo] -> UnitLinkOpts
collectLinkOpts :: GhcNameVersion -> Ways -> [UnitInfo] -> UnitLinkOpts
collectLinkOpts GhcNameVersion
namever Ways
ways [UnitInfo]
ps = UnitLinkOpts
  { hsLibs :: [[Char]]
hsLibs     = (UnitInfo -> [[Char]]) -> [UnitInfo] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-l" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ([[Char]] -> [[Char]])
-> (UnitInfo -> [[Char]]) -> UnitInfo -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhcNameVersion -> Ways -> UnitInfo -> [[Char]]
unitHsLibs GhcNameVersion
namever Ways
ways) [UnitInfo]
ps
  , extraLibs :: [[Char]]
extraLibs  = (UnitInfo -> [[Char]]) -> [UnitInfo] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-l" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ([[Char]] -> [[Char]])
-> (UnitInfo -> [[Char]]) -> UnitInfo -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShortText -> [Char]) -> [ShortText] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShortText -> [Char]
ST.unpack ([ShortText] -> [[Char]])
-> (UnitInfo -> [ShortText]) -> UnitInfo -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> [ShortText]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepLibsSys) [UnitInfo]
ps
  , otherFlags :: [[Char]]
otherFlags = (UnitInfo -> [[Char]]) -> [UnitInfo] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((ShortText -> [Char]) -> [ShortText] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShortText -> [Char]
ST.unpack ([ShortText] -> [[Char]])
-> (UnitInfo -> [ShortText]) -> UnitInfo -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> [ShortText]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLinkerOptions) [UnitInfo]
ps
  }

collectArchives :: GhcNameVersion -> Ways -> UnitInfo -> IO [FilePath]
collectArchives :: GhcNameVersion -> Ways -> UnitInfo -> IO [[Char]]
collectArchives GhcNameVersion
namever Ways
ways UnitInfo
pc =
  ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
doesFileExist [ [Char]
searchPath [Char] -> ShowS
</> ([Char]
"lib" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
lib [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".a")
                        | [Char]
searchPath <- [[Char]]
searchPaths
                        , [Char]
lib <- [[Char]]
libs ]
  where searchPaths :: [[Char]]
searchPaths = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
ordNub ([[Char]] -> [[Char]])
-> (UnitInfo -> [[Char]]) -> UnitInfo -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
forall (f :: * -> *) a. Foldable f => f a -> Bool
notNull ([[Char]] -> [[Char]])
-> (UnitInfo -> [[Char]]) -> UnitInfo -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ways -> UnitInfo -> [[Char]]
libraryDirsForWay Ways
ways (UnitInfo -> [[Char]]) -> UnitInfo -> [[Char]]
forall a b. (a -> b) -> a -> b
$ UnitInfo
pc
        libs :: [[Char]]
libs        = GhcNameVersion -> Ways -> UnitInfo -> [[Char]]
unitHsLibs GhcNameVersion
namever Ways
ways UnitInfo
pc [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (ShortText -> [Char]) -> [ShortText] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShortText -> [Char]
ST.unpack (UnitInfo -> [ShortText]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitExtDepLibsSys UnitInfo
pc)

-- | Either the 'unitLibraryDirs' or 'unitLibraryDynDirs' as appropriate for the way.
libraryDirsForWay :: Ways -> UnitInfo -> [String]
libraryDirsForWay :: Ways -> UnitInfo -> [[Char]]
libraryDirsForWay Ways
ws
  | Ways -> Way -> Bool
hasWay Ways
ws Way
WayDyn = (ShortText -> [Char]) -> [ShortText] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShortText -> [Char]
ST.unpack ([ShortText] -> [[Char]])
-> (UnitInfo -> [ShortText]) -> UnitInfo -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> [ShortText]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDynDirs
  | Bool
otherwise        = (ShortText -> [Char]) -> [ShortText] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShortText -> [Char]
ST.unpack ([ShortText] -> [[Char]])
-> (UnitInfo -> [ShortText]) -> UnitInfo -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> [ShortText]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [ShortText]
unitLibraryDirs

getLibs :: GhcNameVersion -> Ways -> UnitEnv -> [UnitId] -> IO [(String,String)]
getLibs :: GhcNameVersion
-> Ways -> UnitEnv -> [UnitId] -> IO [([Char], [Char])]
getLibs GhcNameVersion
namever Ways
ways UnitEnv
unit_env [UnitId]
pkgs = do
  ps <- MaybeErr UnitErr [UnitInfo] -> IO [UnitInfo]
forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr (MaybeErr UnitErr [UnitInfo] -> IO [UnitInfo])
-> MaybeErr UnitErr [UnitInfo] -> IO [UnitInfo]
forall a b. (a -> b) -> a -> b
$ UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' UnitEnv
unit_env [UnitId]
pkgs
  fmap concat . forM ps $ \UnitInfo
p -> do
    let candidates :: [([Char], [Char])]
candidates = [ ([Char]
l [Char] -> ShowS
</> [Char]
f, [Char]
f) | [Char]
l <- Ways -> [UnitInfo] -> [[Char]]
collectLibraryDirs Ways
ways [UnitInfo
p]
                                    , [Char]
f <- (\[Char]
n -> [Char]
"lib" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".a") ShowS -> [[Char]] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcNameVersion -> Ways -> UnitInfo -> [[Char]]
unitHsLibs GhcNameVersion
namever Ways
ways UnitInfo
p ]
    (([Char], [Char]) -> IO Bool)
-> [([Char], [Char])] -> IO [([Char], [Char])]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ([Char] -> IO Bool
doesFileExist ([Char] -> IO Bool)
-> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], [Char])]
candidates