    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 Data.Char
    import Data.Maybe
    import Control.Monad (join, forM, filterM, void)
    import System.Directory (doesFileExist, getHomeDirectory)
    import System.FilePath ((</>), (<.>))
    import Text.ParserCombinators.ReadP as Parser

    -- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused
    -- libraries from the dynamic library.  We do this to reduce the number of load
    -- commands that end up in the dylib, and has been limited to 32K (32768) since
    -- macOS Sierra (10.14).
    --
    -- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing
    -- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not
    -- being included in the load commands, however the @-rpath@ entries are all
    -- forced to be included.  This can lead to 100s of @-rpath@ entries being
    -- included when only a handful of libraries end up being truly linked.
    --
    -- Thus after building the library, we run a fixup phase where we inject the
    -- @-rpath@ for each found library (in the given library search paths) into the
    -- dynamic library through @-add_rpath@.
    --
    -- See Note [Dynamic linking on macOS]
    runInjectRPaths :: Logger -> DynFlags -> [FilePath] -> FilePath -> IO ()
    -- Make sure to honour -fno-use-rpaths if set on darwin as well see #20004
    runInjectRPaths :: Logger -> DynFlags -> [FilePath] -> FilePath -> IO ()
    runInjectRPaths Logger
    _ DynFlags
    dflags [FilePath]
    _ FilePath
    _ | Bool -> Bool
    not (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_RPath DynFlags
    dflags) = () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    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]
      -- filter the output for only the libraries. And then drop the @rpath prefix.
      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
      -- find any pre-existing LC_PATH items
      [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 paths :: [FilePath]
    paths = (FilePath -> Maybe FilePath) -> [FilePath] -> [FilePath]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe FilePath -> Maybe FilePath
    get_rpath [FilePath]
    info
          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) ]
      -- only find those rpaths, that aren't already in the library.
      [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')
      -- inject the rpaths
      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]

    get_rpath :: String -> Maybe FilePath
    get_rpath :: FilePath -> Maybe FilePath
    get_rpath FilePath
    l = case ReadP FilePath -> ReadS FilePath
    forall a. ReadP a -> ReadS a
    readP_to_S ReadP FilePath
    rpath_parser FilePath
    l of
                    [(FilePath
    rpath, FilePath
    "")] -> FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    rpath
                    [(FilePath, FilePath)]
    _ -> Maybe FilePath
    forall a. Maybe a
    Nothing

    rpath_parser :: ReadP FilePath
    rpath_parser :: ReadP FilePath
    rpath_parser = do
      ReadP ()
    skipSpaces
      ReadP FilePath -> ReadP ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ReadP FilePath -> ReadP ()) -> ReadP FilePath -> ReadP ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> ReadP FilePath
    string FilePath
    "path"
      ReadP FilePath -> ReadP ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ReadP FilePath -> ReadP ()) -> ReadP FilePath -> ReadP ()
    forall a b. (a -> b) -> a -> b
    $ ReadP Char -> ReadP FilePath
    forall a. ReadP a -> ReadP [a]
    many1 ((Char -> Bool) -> ReadP Char
    satisfy Char -> Bool
    isSpace)
      FilePath
    rpath <- ReadP Char -> ReadP FilePath
    forall a. ReadP a -> ReadP [a]
    many ReadP Char
    get
      ReadP FilePath -> ReadP ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ReadP FilePath -> ReadP ()) -> ReadP FilePath -> ReadP ()
    forall a b. (a -> b) -> a -> b
    $ ReadP Char -> ReadP FilePath
    forall a. ReadP a -> ReadP [a]
    many1 ((Char -> Bool) -> ReadP Char
    satisfy Char -> Bool
    isSpace)
      ReadP FilePath -> ReadP ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ReadP FilePath -> ReadP ()) -> ReadP FilePath -> ReadP ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> ReadP FilePath
    string FilePath
    "(offset "
      ReadP FilePath -> ReadP ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ReadP FilePath -> ReadP ()) -> ReadP FilePath -> ReadP ()
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> ReadP FilePath
    munch1 Char -> Bool
    isDigit
      ReadP Char -> ReadP ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ReadP Char -> ReadP ()) -> ReadP Char -> ReadP ()
    forall a b. (a -> b) -> a -> b
    $ Char -> ReadP Char
    Parser.char Char
    ')'
      ReadP ()
    skipSpaces
      FilePath -> ReadP FilePath
    forall (m :: * -> *) a. Monad m => a -> m a
    return FilePath
    rpath

    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
        -- reverse because they're added in reverse order from the cmd line:
        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 ]

    {-
    Note [macOS Big Sur dynamic libraries]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    macOS Big Sur makes the following change to how frameworks are shipped
    with the OS:

    > New in macOS Big Sur 11 beta, the system ships with a built-in
    > dynamic linker cache of all system-provided libraries.  As part of
    > this change, copies of dynamic libraries are no longer present on
    > the filesystem.  Code that attempts to check for dynamic library
    > presence by looking for a file at a path or enumerating a directory
    > will fail.  Instead, check for library presence by attempting to
    > dlopen() the path, which will correctly check for the library in the
    > cache. (62986286)

    (https://developer.apple.com/documentation/macos-release-notes/macos-big-sur-11-beta-release-notes/)

    Therefore, the previous method of checking whether a library exists
    before attempting to load it makes GHC.Linker.MacOS.loadFramework
    fail to find frameworks installed at /System/Library/Frameworks.
    Instead, any attempt to load a framework at runtime, such as by
    passing -framework OpenGL to runghc or running code loading such a
    framework with GHCi, fails with a 'not found' message.

    GHC.Linker.MacOS.loadFramework now opportunistically loads the
    framework libraries without checking for their existence first,
    failing only if all attempts to load a given framework from any of the
    various possible locations fail.  See also #18446, which this change
    addresses.
    -}

    -- Darwin / MacOS X only: load a framework
    -- a framework is a dynamic library packaged inside a directory of the same
    -- name. They are searched for in different paths than normal libraries.
    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

         -- sorry for the hardcoded paths, I hope they won't change anytime soon:
         defaultFrameworkPaths :: [FilePath]
    defaultFrameworkPaths = [FilePath
    "/Library/Frameworks", FilePath
    "/System/Library/Frameworks"]

         -- Try to call loadDLL for each candidate path.
         --
         -- See Note [macOS Big Sur dynamic libraries]
         findLoadDLL :: [FilePath] -> [FilePath] -> IO (Maybe [FilePath])
    findLoadDLL [] [FilePath]
    errs =
           -- Tried all our known library paths, but dlopen()
           -- has no built-in paths for frameworks: give up
           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)
              }