module GHC.Linker.MacOS
( runInjectRPaths
, getUnitFrameworkOpts
, getFrameworkOpts
, loadFramework
)
where
import GHC.Prelude
import GHC.Platform
import GHC.Driver.Session
import GHC.Unit.Types
import GHC.Unit.State
import GHC.Unit.Env
import GHC.SysTools.Tasks
import GHC.Runtime.Interpreter
import GHC.Utils.Exception
import GHC.Utils.Logger
import Data.List (isPrefixOf, nub, sort, intersperse, intercalate)
import Control.Monad (join, forM, filterM)
import System.Directory (doesFileExist, getHomeDirectory)
import System.FilePath ((</>), (<.>))
runInjectRPaths :: Logger -> DynFlags -> [FilePath] -> FilePath -> IO ()
runInjectRPaths :: Logger -> DynFlags -> [FilePath] -> FilePath -> IO ()
runInjectRPaths Logger
logger DynFlags
dflags [FilePath]
lib_paths FilePath
dylib = do
[FilePath]
info <- FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Logger -> DynFlags -> Maybe FilePath -> [Option] -> IO FilePath
askOtool Logger
logger DynFlags
dflags Maybe FilePath
forall a. Maybe a
Nothing [FilePath -> Option
Option FilePath
"-L", FilePath -> Option
Option FilePath
dylib]
let libs :: [FilePath]
libs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
7) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"@rpath") ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath] -> FilePath
forall a. [a] -> a
head([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FilePath -> [FilePath]
words) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
info
[[FilePath]]
info <- (FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> [FilePath]
words([FilePath] -> [[FilePath]])
-> (FilePath -> [FilePath]) -> FilePath -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FilePath -> [FilePath]
lines (FilePath -> [[FilePath]]) -> IO FilePath -> IO [[FilePath]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Logger -> DynFlags -> Maybe FilePath -> [Option] -> IO FilePath
askOtool Logger
logger DynFlags
dflags Maybe FilePath
forall a. Maybe a
Nothing [FilePath -> Option
Option FilePath
"-l", FilePath -> Option
Option FilePath
dylib]
let paths :: [FilePath]
paths = ([FilePath] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [FilePath] -> [FilePath]
f [[FilePath]]
info
where f :: [FilePath] -> [FilePath]
f (FilePath
"path":FilePath
p:[FilePath]
_) = [FilePath
p]
f [FilePath]
_ = []
lib_paths' :: [FilePath]
lib_paths' = [ FilePath
p | FilePath
p <- [FilePath]
lib_paths, Bool -> Bool
not (FilePath
p FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
paths) ]
[FilePath]
rpaths <- [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath])
-> ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath])
-> ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePath]] -> [FilePath]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
libs (\FilePath
f -> (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\FilePath
l -> FilePath -> IO Bool
doesFileExist (FilePath
l FilePath -> FilePath -> FilePath
</> FilePath
f)) [FilePath]
lib_paths')
case [FilePath]
rpaths of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[FilePath]
_ -> Logger -> DynFlags -> [Option] -> IO ()
runInstallNameTool Logger
logger DynFlags
dflags ([Option] -> IO ()) -> [Option] -> IO ()
forall a b. (a -> b) -> a -> b
$ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
Option ([FilePath] -> [Option]) -> [FilePath] -> [Option]
forall a b. (a -> b) -> a -> b
$ FilePath
"-add_rpath"FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:(FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
intersperse FilePath
"-add_rpath" [FilePath]
rpaths) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
dylib]
getUnitFrameworkOpts :: UnitEnv -> [UnitId] -> IO [String]
getUnitFrameworkOpts :: UnitEnv -> [UnitId] -> IO [FilePath]
getUnitFrameworkOpts UnitEnv
unit_env [UnitId]
dep_packages
| Platform -> Bool
platformUsesFrameworks (UnitEnv -> Platform
ue_platform UnitEnv
unit_env) = do
[UnitInfo]
ps <- MaybeErr UnitErr [UnitInfo] -> IO [UnitInfo]
forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr (UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' UnitEnv
unit_env [UnitId]
dep_packages)
let pkg_framework_path_opts :: [FilePath]
pkg_framework_path_opts = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"-F" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) ([UnitInfo] -> [FilePath]
collectFrameworksDirs [UnitInfo]
ps)
pkg_framework_opts :: [FilePath]
pkg_framework_opts = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [FilePath
"-framework", FilePath
fw]
| FilePath
fw <- [UnitInfo] -> [FilePath]
collectFrameworks [UnitInfo]
ps
]
[FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
pkg_framework_path_opts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkg_framework_opts)
| Bool
otherwise = [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getFrameworkOpts :: DynFlags -> Platform -> [String]
getFrameworkOpts :: DynFlags -> Platform -> [FilePath]
getFrameworkOpts DynFlags
dflags Platform
platform
| Platform -> Bool
platformUsesFrameworks Platform
platform = [FilePath]
framework_path_opts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
framework_opts
| Bool
otherwise = []
where
framework_paths :: [FilePath]
framework_paths = DynFlags -> [FilePath]
frameworkPaths DynFlags
dflags
framework_path_opts :: [FilePath]
framework_path_opts = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"-F" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) [FilePath]
framework_paths
frameworks :: [FilePath]
frameworks = DynFlags -> [FilePath]
cmdlineFrameworks DynFlags
dflags
framework_opts :: [FilePath]
framework_opts = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [FilePath
"-framework", FilePath
fw]
| FilePath
fw <- [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
frameworks ]
loadFramework :: Interp -> [FilePath] -> FilePath -> IO (Maybe String)
loadFramework :: Interp -> [FilePath] -> FilePath -> IO (Maybe FilePath)
loadFramework Interp
interp [FilePath]
extraPaths FilePath
rootname
= do { Either IOException FilePath
either_dir <- IO FilePath -> IO (Either IOException FilePath)
forall a. IO a -> IO (Either IOException a)
tryIO IO FilePath
getHomeDirectory
; let homeFrameworkPath :: [FilePath]
homeFrameworkPath = case Either IOException FilePath
either_dir of
Left IOException
_ -> []
Right FilePath
dir -> [FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"Library/Frameworks"]
ps :: [FilePath]
ps = [FilePath]
extraPaths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
homeFrameworkPath [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
defaultFrameworkPaths
; Maybe [FilePath]
errs <- [FilePath] -> [FilePath] -> IO (Maybe [FilePath])
findLoadDLL [FilePath]
ps []
; Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ ([FilePath] -> FilePath) -> Maybe [FilePath] -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", ") Maybe [FilePath]
errs
}
where
fwk_file :: FilePath
fwk_file = FilePath
rootname FilePath -> FilePath -> FilePath
<.> FilePath
"framework" FilePath -> FilePath -> FilePath
</> FilePath
rootname
defaultFrameworkPaths :: [FilePath]
defaultFrameworkPaths = [FilePath
"/Library/Frameworks", FilePath
"/System/Library/Frameworks"]
findLoadDLL :: [FilePath] -> [FilePath] -> IO (Maybe [FilePath])
findLoadDLL [] [FilePath]
errs =
Maybe [FilePath] -> IO (Maybe [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [FilePath] -> IO (Maybe [FilePath]))
-> Maybe [FilePath] -> IO (Maybe [FilePath])
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe [FilePath]
forall a. a -> Maybe a
Just [FilePath]
errs
findLoadDLL (FilePath
p:[FilePath]
ps) [FilePath]
errs =
do { Maybe FilePath
dll <- Interp -> FilePath -> IO (Maybe FilePath)
loadDLL Interp
interp (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
fwk_file)
; case Maybe FilePath
dll of
Maybe FilePath
Nothing -> Maybe [FilePath] -> IO (Maybe [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [FilePath]
forall a. Maybe a
Nothing
Just FilePath
err -> [FilePath] -> [FilePath] -> IO (Maybe [FilePath])
findLoadDLL [FilePath]
ps ((FilePath
p FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err)FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
errs)
}