{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.LocalBuildInfo
-- Copyright   :  Isaac Jones 2003-2004
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Once a package has been configured we have resolved conditionals and
-- dependencies, configured the compiler and other needed external programs.
-- The 'LocalBuildInfo' is used to hold all this information. It holds the
-- install dirs, the compiler, the exact package dependencies, the configured
-- programs, the package database to use and a bunch of miscellaneous configure
-- flags. It gets saved and reloaded from a file (@dist\/setup-config@). It gets
-- passed in to very many subsequent build actions.
module Distribution.Simple.LocalBuildInfo
  ( LocalBuildInfo (..)
  , localComponentId
  , localUnitId
  , localCompatPackageKey

    -- * Convenience accessors
  , buildDir
  , packageRoot
  , progPrefix
  , progSuffix
  , interpretSymbolicPathLBI
  , mbWorkDirLBI
  , absoluteWorkingDirLBI
  , buildWays

    -- * Buildable package components
  , Component (..)
  , ComponentName (..)
  , LibraryName (..)
  , defaultLibName
  , showComponentName
  , componentNameString
  , ComponentLocalBuildInfo (..)
  , componentBuildDir
  , foldComponent
  , componentName
  , componentBuildInfo
  , componentBuildable
  , pkgComponents
  , pkgBuildableComponents
  , lookupComponent
  , getComponent
  , allComponentsInBuildOrder
  , depLibraryPaths
  , allLibModules
  , withAllComponentsInBuildOrder
  , withLibLBI
  , withExeLBI
  , withBenchLBI
  , withTestLBI
  , enabledTestLBIs
  , enabledBenchLBIs

    -- * Installation directories
  , module Distribution.Simple.InstallDirs
  , absoluteInstallDirs
  , prefixRelativeInstallDirs
  , absoluteInstallCommandDirs
  , absoluteComponentInstallDirs
  , prefixRelativeComponentInstallDirs
  , substPathTemplate
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Types.Component
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.ComponentName
import Distribution.Types.LocalBuildInfo
import Distribution.Types.PackageDescription
import Distribution.Types.PackageId
import Distribution.Types.TargetInfo
import Distribution.Types.UnitId
import Distribution.Types.UnqualComponentName

import qualified Distribution.Compat.Graph as Graph
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.ModuleName
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Pretty
import Distribution.Simple.Compiler
import Distribution.Simple.Flag
import Distribution.Simple.InstallDirs hiding
  ( absoluteInstallDirs
  , prefixRelativeInstallDirs
  , substPathTemplate
  )
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.PackageIndex
import Distribution.Simple.Setup.Common
import Distribution.Simple.Setup.Config
import Distribution.Simple.Utils
import Distribution.Utils.Path

import Data.List (stripPrefix)
import qualified System.Directory as Directory
  ( canonicalizePath
  , doesDirectoryExist
  )

-- -----------------------------------------------------------------------------
-- Configuration information of buildable components

componentBuildDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> SymbolicPath Pkg (Dir Build)
-- For now, we assume that libraries/executables/test-suites/benchmarks
-- are only ever built once.  With Backpack, we need a special case for
-- libraries so that we can handle building them multiple times.
componentBuildDir :: LocalBuildInfo
-> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi =
  (LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Build)
-> RelativePath Build ('Dir Build) -> SymbolicPath Pkg ('Dir Build)
forall p q r. PathLike p q r => p -> q -> r
</>) (RelativePath Build ('Dir Build) -> SymbolicPath Pkg ('Dir Build))
-> RelativePath Build ('Dir Build) -> SymbolicPath Pkg ('Dir Build)
forall a b. (a -> b) -> a -> b
$
    String -> RelativePath Build ('Dir Build)
forall from (to :: FileOrDir).
HasCallStack =>
String -> RelativePath from to
makeRelativePathEx (String -> RelativePath Build ('Dir Build))
-> String -> RelativePath Build ('Dir Build)
forall a b. (a -> b) -> a -> b
$
      case ComponentLocalBuildInfo -> ComponentName
componentLocalName ComponentLocalBuildInfo
clbi of
        CLibName LibraryName
LMainLibName ->
          if UnitId -> String
forall a. Pretty a => a -> String
prettyShow (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentId -> String
forall a. Pretty a => a -> String
prettyShow (ComponentLocalBuildInfo -> ComponentId
componentComponentId ComponentLocalBuildInfo
clbi)
            then String
""
            else UnitId -> String
forall a. Pretty a => a -> String
prettyShow (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi)
        CLibName (LSubLibName UnqualComponentName
s) ->
          if UnitId -> String
forall a. Pretty a => a -> String
prettyShow (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentId -> String
forall a. Pretty a => a -> String
prettyShow (ComponentLocalBuildInfo -> ComponentId
componentComponentId ComponentLocalBuildInfo
clbi)
            then UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
s
            else UnitId -> String
forall a. Pretty a => a -> String
prettyShow (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi)
        CFLibName UnqualComponentName
s -> UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
s
        CExeName UnqualComponentName
s -> UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
s
        CTestName UnqualComponentName
s -> UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
s
        CBenchName UnqualComponentName
s -> UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
s

-- | Interpret a symbolic path with respect to the working directory
-- stored in 'LocalBuildInfo'.
--
-- Use this before directly interacting with the file system.
--
-- NB: when invoking external programs (such as @GHC@), it is preferable to set
-- the working directory of the process rather than calling this function, as
-- this function will turn relative paths into absolute paths if the working
-- directory is an absolute path. This can degrade error messages, or worse,
-- break the behaviour entirely (because the program might expect certain paths
-- to be relative).
--
-- See Note [Symbolic paths] in Distribution.Utils.Path
interpretSymbolicPathLBI :: LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> FilePath
interpretSymbolicPathLBI :: forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> String
interpretSymbolicPathLBI LocalBuildInfo
lbi =
  Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> String
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> String
interpretSymbolicPath (LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi)

-- | Retrieve an optional working directory from 'LocalBuildInfo'.
mbWorkDirLBI :: LocalBuildInfo -> Maybe (SymbolicPath CWD (Dir Pkg))
mbWorkDirLBI :: LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI =
  Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
 -> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> (LocalBuildInfo -> Flag (SymbolicPath CWD ('Dir Pkg)))
-> LocalBuildInfo
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonSetupFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
setupWorkingDir (CommonSetupFlags -> Flag (SymbolicPath CWD ('Dir Pkg)))
-> (LocalBuildInfo -> CommonSetupFlags)
-> LocalBuildInfo
-> Flag (SymbolicPath CWD ('Dir Pkg))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigFlags -> CommonSetupFlags
configCommonFlags (ConfigFlags -> CommonSetupFlags)
-> (LocalBuildInfo -> ConfigFlags)
-> LocalBuildInfo
-> CommonSetupFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> ConfigFlags
configFlags

-- | Absolute path to the current working directory.
absoluteWorkingDirLBI :: LocalBuildInfo -> IO (AbsolutePath (Dir Pkg))
absoluteWorkingDirLBI :: LocalBuildInfo -> IO (AbsolutePath ('Dir Pkg))
absoluteWorkingDirLBI LocalBuildInfo
lbi = Maybe (SymbolicPath CWD ('Dir Pkg)) -> IO (AbsolutePath ('Dir Pkg))
forall (to :: FileOrDir).
Maybe (SymbolicPath CWD to) -> IO (AbsolutePath to)
absoluteWorkingDir (LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi)

-- | Perform the action on each enabled 'library' in the package
-- description with the 'ComponentLocalBuildInfo'.
withLibLBI
  :: PackageDescription
  -> LocalBuildInfo
  -> (Library -> ComponentLocalBuildInfo -> IO ())
  -> IO ()
withLibLBI :: PackageDescription
-> LocalBuildInfo
-> (Library -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withLibLBI PackageDescription
pkg LocalBuildInfo
lbi Library -> ComponentLocalBuildInfo -> IO ()
f =
  PackageDescription
-> LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder' PackageDescription
pkg LocalBuildInfo
lbi ((TargetInfo -> IO ()) -> IO ()) -> (TargetInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TargetInfo
target ->
    case TargetInfo -> Component
targetComponent TargetInfo
target of
      CLib Library
lib -> Library -> ComponentLocalBuildInfo -> IO ()
f Library
lib (TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target)
      Component
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Perform the action on each enabled 'Executable' in the package
-- description.  Extended version of 'withExe' that also gives corresponding
-- build info.
withExeLBI
  :: PackageDescription
  -> LocalBuildInfo
  -> (Executable -> ComponentLocalBuildInfo -> IO ())
  -> IO ()
withExeLBI :: PackageDescription
-> LocalBuildInfo
-> (Executable -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withExeLBI PackageDescription
pkg LocalBuildInfo
lbi Executable -> ComponentLocalBuildInfo -> IO ()
f =
  PackageDescription
-> LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder' PackageDescription
pkg LocalBuildInfo
lbi ((TargetInfo -> IO ()) -> IO ()) -> (TargetInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TargetInfo
target ->
    case TargetInfo -> Component
targetComponent TargetInfo
target of
      CExe Executable
exe -> Executable -> ComponentLocalBuildInfo -> IO ()
f Executable
exe (TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target)
      Component
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Perform the action on each enabled 'Benchmark' in the package
-- description.
withBenchLBI
  :: PackageDescription
  -> LocalBuildInfo
  -> (Benchmark -> ComponentLocalBuildInfo -> IO ())
  -> IO ()
withBenchLBI :: PackageDescription
-> LocalBuildInfo
-> (Benchmark -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withBenchLBI PackageDescription
pkg LocalBuildInfo
lbi Benchmark -> ComponentLocalBuildInfo -> IO ()
f =
  [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Benchmark -> ComponentLocalBuildInfo -> IO ()
f Benchmark
bench ComponentLocalBuildInfo
clbi | (Benchmark
bench, ComponentLocalBuildInfo
clbi) <- PackageDescription
-> LocalBuildInfo -> [(Benchmark, ComponentLocalBuildInfo)]
enabledBenchLBIs PackageDescription
pkg LocalBuildInfo
lbi]

withTestLBI
  :: PackageDescription
  -> LocalBuildInfo
  -> (TestSuite -> ComponentLocalBuildInfo -> IO ())
  -> IO ()
withTestLBI :: PackageDescription
-> LocalBuildInfo
-> (TestSuite -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withTestLBI PackageDescription
pkg LocalBuildInfo
lbi TestSuite -> ComponentLocalBuildInfo -> IO ()
f =
  [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [TestSuite -> ComponentLocalBuildInfo -> IO ()
f TestSuite
test ComponentLocalBuildInfo
clbi | (TestSuite
test, ComponentLocalBuildInfo
clbi) <- PackageDescription
-> LocalBuildInfo -> [(TestSuite, ComponentLocalBuildInfo)]
enabledTestLBIs PackageDescription
pkg LocalBuildInfo
lbi]

enabledTestLBIs
  :: PackageDescription
  -> LocalBuildInfo
  -> [(TestSuite, ComponentLocalBuildInfo)]
enabledTestLBIs :: PackageDescription
-> LocalBuildInfo -> [(TestSuite, ComponentLocalBuildInfo)]
enabledTestLBIs PackageDescription
pkg LocalBuildInfo
lbi =
  [ (TestSuite
test, TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target)
  | TargetInfo
target <- PackageDescription -> LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder' PackageDescription
pkg LocalBuildInfo
lbi
  , CTest TestSuite
test <- [TargetInfo -> Component
targetComponent TargetInfo
target]
  ]

enabledBenchLBIs
  :: PackageDescription
  -> LocalBuildInfo
  -> [(Benchmark, ComponentLocalBuildInfo)]
enabledBenchLBIs :: PackageDescription
-> LocalBuildInfo -> [(Benchmark, ComponentLocalBuildInfo)]
enabledBenchLBIs PackageDescription
pkg LocalBuildInfo
lbi =
  [ (Benchmark
bench, TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target)
  | TargetInfo
target <- PackageDescription -> LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder' PackageDescription
pkg LocalBuildInfo
lbi
  , CBench Benchmark
bench <- [TargetInfo -> Component
targetComponent TargetInfo
target]
  ]

-- | Perform the action on each buildable 'Library' or 'Executable' (Component)
-- in the PackageDescription, subject to the build order specified by the
-- 'compBuildOrder' field of the given 'LocalBuildInfo'
withAllComponentsInBuildOrder
  :: PackageDescription
  -> LocalBuildInfo
  -> (Component -> ComponentLocalBuildInfo -> IO ())
  -> IO ()
withAllComponentsInBuildOrder :: PackageDescription
-> LocalBuildInfo
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withAllComponentsInBuildOrder PackageDescription
pkg LocalBuildInfo
lbi Component -> ComponentLocalBuildInfo -> IO ()
f =
  PackageDescription
-> LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder' PackageDescription
pkg LocalBuildInfo
lbi ((TargetInfo -> IO ()) -> IO ()) -> (TargetInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TargetInfo
target ->
    Component -> ComponentLocalBuildInfo -> IO ()
f (TargetInfo -> Component
targetComponent TargetInfo
target) (TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
target)

allComponentsInBuildOrder
  :: LocalBuildInfo
  -> [ComponentLocalBuildInfo]
allComponentsInBuildOrder :: LocalBuildInfo -> [ComponentLocalBuildInfo]
allComponentsInBuildOrder (LocalBuildInfo{componentGraph :: LocalBuildInfo -> Graph ComponentLocalBuildInfo
componentGraph = Graph ComponentLocalBuildInfo
compGraph}) =
  Graph ComponentLocalBuildInfo -> [ComponentLocalBuildInfo]
forall a. Graph a -> [a]
Graph.topSort Graph ComponentLocalBuildInfo
compGraph

-- -----------------------------------------------------------------------------
-- A random function that has no business in this module

-- | Determine the directories containing the dynamic libraries of the
-- transitive dependencies of the component we are building.
--
-- When wanted, and possible, returns paths relative to the installDirs 'prefix'
depLibraryPaths
  :: Bool
  -- ^ Building for inplace?
  -> Bool
  -- ^ Generate prefix-relative library paths
  -> LocalBuildInfo
  -> ComponentLocalBuildInfo
  -- ^ Component that is being built
  -> IO [FilePath]
depLibraryPaths :: Bool
-> Bool -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO [String]
depLibraryPaths
  Bool
inplace
  Bool
relative
  lbi :: LocalBuildInfo
lbi@( LocalBuildInfo
          { localPkgDescr :: LocalBuildInfo -> PackageDescription
localPkgDescr = PackageDescription
pkgDescr
          , installedPkgs :: LocalBuildInfo -> InstalledPackageIndex
installedPkgs = InstalledPackageIndex
installed
          }
        )
  ComponentLocalBuildInfo
clbi = do
    let installDirs :: InstallDirs String
installDirs = PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs String
absoluteComponentInstallDirs PackageDescription
pkgDescr LocalBuildInfo
lbi (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
clbi) CopyDest
NoCopyDest
        executable :: Bool
executable = case ComponentLocalBuildInfo
clbi of
          ExeComponentLocalBuildInfo{} -> Bool
True
          ComponentLocalBuildInfo
_ -> Bool
False
        relDir :: String
relDir
          | Bool
executable = InstallDirs String -> String
forall dir. InstallDirs dir -> dir
bindir InstallDirs String
installDirs
          | Bool
otherwise = InstallDirs String -> String
forall dir. InstallDirs dir -> dir
libdir InstallDirs String
installDirs

    let
      -- TODO: this is kind of inefficient
      internalDeps :: [UnitId]
internalDeps =
        [ UnitId
uid
        | (UnitId
uid, MungedPackageId
_) <- ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
clbi
        , -- Test that it's internal
        TargetInfo
sub_target <- PackageDescription -> LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder' PackageDescription
pkgDescr LocalBuildInfo
lbi
        , ComponentLocalBuildInfo -> UnitId
componentUnitId (TargetInfo -> ComponentLocalBuildInfo
targetCLBI (TargetInfo
sub_target)) UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
uid
        ]
      internalLibs :: [String]
internalLibs =
        [ ComponentLocalBuildInfo -> String
getLibDir (TargetInfo -> ComponentLocalBuildInfo
targetCLBI TargetInfo
sub_target)
        | TargetInfo
sub_target <-
            PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder'
              PackageDescription
pkgDescr
              LocalBuildInfo
lbi
              [UnitId]
internalDeps
        ]
      {-
      -- This is better, but it doesn't work, because we may be passed a
      -- CLBI which doesn't actually exist, and was faked up when we
      -- were building a test suite/benchmark.  See #3599 for proposal
      -- to fix this.
      let internalCLBIs = filter ((/= componentUnitId clbi) . componentUnitId)
                        . map targetCLBI
                        $ neededTargetsInBuildOrder lbi [componentUnitId clbi]
          internalLibs = map getLibDir internalCLBIs
      -}
      getLibDir :: ComponentLocalBuildInfo -> String
getLibDir ComponentLocalBuildInfo
sub_clbi
        | Bool
inplace = LocalBuildInfo -> SymbolicPath Pkg ('Dir Build) -> String
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> String
interpretSymbolicPathLBI LocalBuildInfo
lbi (SymbolicPath Pkg ('Dir Build) -> String)
-> SymbolicPath Pkg ('Dir Build) -> String
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
-> ComponentLocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
componentBuildDir LocalBuildInfo
lbi ComponentLocalBuildInfo
sub_clbi
        | Bool
otherwise = InstallDirs String -> String
forall dir. InstallDirs dir -> dir
dynlibdir (PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs String
absoluteComponentInstallDirs PackageDescription
pkgDescr LocalBuildInfo
lbi (ComponentLocalBuildInfo -> UnitId
componentUnitId ComponentLocalBuildInfo
sub_clbi) CopyDest
NoCopyDest)

    -- Why do we go through all the trouble of a hand-crafting
    -- internalLibs, when 'installedPkgs' actually contains the
    -- internal libraries?  The trouble is that 'installedPkgs'
    -- may contain *inplace* entries, which we must NOT use for
    -- not inplace 'depLibraryPaths' (e.g., for RPATH calculation).
    -- See #4025 for more details. This is all horrible but it
    -- is a moot point if you are using a per-component build,
    -- because you never have any internal libraries in this case;
    -- they're all external.
    let external_ipkgs :: [InstalledPackageInfo]
external_ipkgs = (InstalledPackageInfo -> Bool)
-> [InstalledPackageInfo] -> [InstalledPackageInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter InstalledPackageInfo -> Bool
forall {pkg}. HasUnitId pkg => pkg -> Bool
is_external (InstalledPackageIndex -> [InstalledPackageInfo]
forall a. PackageIndex a -> [a]
allPackages InstalledPackageIndex
installed)
        is_external :: pkg -> Bool
is_external pkg
ipkg = Bool -> Bool
not (pkg -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId pkg
ipkg UnitId -> [UnitId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UnitId]
internalDeps)
        -- First look for dynamic libraries in `dynamic-library-dirs`, and use
        -- `library-dirs` as a fall back.
        getDynDir :: InstalledPackageInfo -> [String]
getDynDir InstalledPackageInfo
pkg = case InstalledPackageInfo -> [String]
Installed.libraryDynDirs InstalledPackageInfo
pkg of
          [] -> InstalledPackageInfo -> [String]
Installed.libraryDirs InstalledPackageInfo
pkg
          [String]
d -> [String]
d
        allDepLibDirs :: [String]
allDepLibDirs = (InstalledPackageInfo -> [String])
-> [InstalledPackageInfo] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InstalledPackageInfo -> [String]
getDynDir [InstalledPackageInfo]
external_ipkgs

        allDepLibDirs' :: [String]
allDepLibDirs' = [String]
internalLibs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
allDepLibDirs
    allDepLibDirsC <- (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse String -> IO String
canonicalizePathNoFail [String]
allDepLibDirs'

    let p = InstallDirs String -> String
forall dir. InstallDirs dir -> dir
prefix InstallDirs String
installDirs
        prefixRelative String
l = Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
p String
l)
        libPaths
          | Bool
relative
              Bool -> Bool -> Bool
&& String -> Bool
prefixRelative String
relDir =
              (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
                ( \String
l ->
                    if String -> Bool
prefixRelative String
l
                      then String -> String -> String
shortRelativePath String
relDir String
l
                      else String
l
                )
                [String]
allDepLibDirsC
          | Bool
otherwise = [String]
allDepLibDirsC

    -- For some reason, this function returns lots of duplicates. Avoid
    -- exceeding `ARG_MAX` (the result of this function is used to populate
    -- `LD_LIBRARY_PATH`) by deduplicating the list.
    return $ ordNub libPaths
    where
      -- 'canonicalizePath' fails on UNIX when the directory does not exists.
      -- So just don't canonicalize when it doesn't exist.
      canonicalizePathNoFail :: String -> IO String
canonicalizePathNoFail String
p = do
        exists <- String -> IO Bool
Directory.doesDirectoryExist String
p
        if exists
          then Directory.canonicalizePath p
          else return p

-- | Get all module names that needed to be built by GHC; i.e., all
-- of these 'ModuleName's have interface files associated with them
-- that need to be installed.
allLibModules :: Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules :: Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi =
  [ModuleName] -> [ModuleName]
forall a. Ord a => [a] -> [a]
ordNub ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$
    Library -> [ModuleName]
explicitLibModules Library
lib
      [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. [a] -> [a] -> [a]
++ case ComponentLocalBuildInfo
clbi of
        LibComponentLocalBuildInfo{componentInstantiatedWith :: ComponentLocalBuildInfo -> [(ModuleName, OpenModule)]
componentInstantiatedWith = [(ModuleName, OpenModule)]
insts} -> ((ModuleName, OpenModule) -> ModuleName)
-> [(ModuleName, OpenModule)] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, OpenModule) -> ModuleName
forall a b. (a, b) -> a
fst [(ModuleName, OpenModule)]
insts
        ComponentLocalBuildInfo
_ -> []

-- -----------------------------------------------------------------------------
-- Wrappers for a couple functions from InstallDirs

-- | Backwards compatibility function which computes the InstallDirs
-- assuming that @$libname@ points to the public library (or some fake
-- package identifier if there is no public library.)  IF AT ALL
-- POSSIBLE, please use 'absoluteComponentInstallDirs' instead.
absoluteInstallDirs
  :: PackageDescription
  -> LocalBuildInfo
  -> CopyDest
  -> InstallDirs FilePath
absoluteInstallDirs :: PackageDescription
-> LocalBuildInfo -> CopyDest -> InstallDirs String
absoluteInstallDirs PackageDescription
pkg LocalBuildInfo
lbi CopyDest
copydest =
  PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs String
absoluteComponentInstallDirs PackageDescription
pkg LocalBuildInfo
lbi (LocalBuildInfo -> UnitId
localUnitId LocalBuildInfo
lbi) CopyDest
copydest

-- | See 'InstallDirs.absoluteInstallDirs'.
absoluteComponentInstallDirs
  :: PackageDescription
  -> LocalBuildInfo
  -> UnitId
  -> CopyDest
  -> InstallDirs FilePath
absoluteComponentInstallDirs :: PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs String
absoluteComponentInstallDirs
  PackageDescription
pkg
  (LocalBuildInfo{compiler :: LocalBuildInfo -> Compiler
compiler = Compiler
comp, hostPlatform :: LocalBuildInfo -> Platform
hostPlatform = Platform
plat, installDirTemplates :: LocalBuildInfo -> InstallDirTemplates
installDirTemplates = InstallDirTemplates
installDirs})
  UnitId
uid
  CopyDest
copydest =
    PackageId
-> UnitId
-> CompilerInfo
-> CopyDest
-> Platform
-> InstallDirTemplates
-> InstallDirs String
InstallDirs.absoluteInstallDirs
      (PackageDescription -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId PackageDescription
pkg)
      UnitId
uid
      (Compiler -> CompilerInfo
compilerInfo Compiler
comp)
      CopyDest
copydest
      Platform
plat
      InstallDirTemplates
installDirs

absoluteInstallCommandDirs
  :: PackageDescription
  -> LocalBuildInfo
  -> UnitId
  -> CopyDest
  -> InstallDirs FilePath
absoluteInstallCommandDirs :: PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs String
absoluteInstallCommandDirs PackageDescription
pkg LocalBuildInfo
lbi UnitId
uid CopyDest
copydest =
  InstallDirs String
dirs
    { -- Handle files which are not
      -- per-component (data files and Haddock files.)
      datadir = datadir dirs'
    , -- NB: The situation with Haddock is a bit delicate.  On the
      -- one hand, the easiest to understand Haddock documentation
      -- path is pkgname-0.1, which means it's per-package (not
      -- per-component).  But this means that it's impossible to
      -- install Haddock documentation for internal libraries.  We'll
      -- keep this constraint for now; this means you can't use
      -- Cabal to Haddock internal libraries.  This does not seem
      -- like a big problem.
      docdir = docdir dirs'
    , htmldir = htmldir dirs'
    , haddockdir = haddockdir dirs'
    }
  where
    dirs :: InstallDirs String
dirs = PackageDescription
-> LocalBuildInfo -> UnitId -> CopyDest -> InstallDirs String
absoluteComponentInstallDirs PackageDescription
pkg LocalBuildInfo
lbi UnitId
uid CopyDest
copydest
    -- Notice use of 'absoluteInstallDirs' (not the
    -- per-component variant).  This means for non-library
    -- packages we'll just pick a nondescriptive foo-0.1
    dirs' :: InstallDirs String
dirs' = PackageDescription
-> LocalBuildInfo -> CopyDest -> InstallDirs String
absoluteInstallDirs PackageDescription
pkg LocalBuildInfo
lbi CopyDest
copydest

-- | Backwards compatibility function which computes the InstallDirs
-- assuming that @$libname@ points to the public library (or some fake
-- package identifier if there is no public library.)  IF AT ALL
-- POSSIBLE, please use 'prefixRelativeComponentInstallDirs' instead.
prefixRelativeInstallDirs
  :: PackageId
  -> LocalBuildInfo
  -> InstallDirs (Maybe FilePath)
prefixRelativeInstallDirs :: PackageId -> LocalBuildInfo -> InstallDirs (Maybe String)
prefixRelativeInstallDirs PackageId
pkg_descr LocalBuildInfo
lbi =
  PackageId -> LocalBuildInfo -> UnitId -> InstallDirs (Maybe String)
prefixRelativeComponentInstallDirs PackageId
pkg_descr LocalBuildInfo
lbi (LocalBuildInfo -> UnitId
localUnitId LocalBuildInfo
lbi)

-- | See 'InstallDirs.prefixRelativeInstallDirs'
prefixRelativeComponentInstallDirs
  :: PackageId
  -> LocalBuildInfo
  -> UnitId
  -> InstallDirs (Maybe FilePath)
prefixRelativeComponentInstallDirs :: PackageId -> LocalBuildInfo -> UnitId -> InstallDirs (Maybe String)
prefixRelativeComponentInstallDirs
  PackageId
pkg_descr
  (LocalBuildInfo{compiler :: LocalBuildInfo -> Compiler
compiler = Compiler
comp, hostPlatform :: LocalBuildInfo -> Platform
hostPlatform = Platform
plat, installDirTemplates :: LocalBuildInfo -> InstallDirTemplates
installDirTemplates = InstallDirTemplates
installDirs})
  UnitId
uid =
    PackageId
-> UnitId
-> CompilerInfo
-> Platform
-> InstallDirTemplates
-> InstallDirs (Maybe String)
InstallDirs.prefixRelativeInstallDirs
      (PackageId -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId PackageId
pkg_descr)
      UnitId
uid
      (Compiler -> CompilerInfo
compilerInfo Compiler
comp)
      Platform
plat
      InstallDirTemplates
installDirs

substPathTemplate
  :: PackageId
  -> LocalBuildInfo
  -> UnitId
  -> PathTemplate
  -> FilePath
substPathTemplate :: PackageId -> LocalBuildInfo -> UnitId -> PathTemplate -> String
substPathTemplate
  PackageId
pkgid
  (LocalBuildInfo{compiler :: LocalBuildInfo -> Compiler
compiler = Compiler
comp, hostPlatform :: LocalBuildInfo -> Platform
hostPlatform = Platform
plat})
  UnitId
uid =
    PathTemplate -> String
fromPathTemplate
      (PathTemplate -> String)
-> (PathTemplate -> PathTemplate) -> PathTemplate -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathTemplateEnv -> PathTemplate -> PathTemplate
InstallDirs.substPathTemplate PathTemplateEnv
env)
    where
      env :: PathTemplateEnv
env =
        PackageId -> UnitId -> CompilerInfo -> Platform -> PathTemplateEnv
initialPathTemplateEnv
          PackageId
pkgid
          UnitId
uid
          (Compiler -> CompilerInfo
compilerInfo Compiler
comp)
          Platform
plat