1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE RankNTypes #-}
4
5-----------------------------------------------------------------------------
6-- |
7-- Module      :  Distribution.Simple.LocalBuildInfo
8-- Copyright   :  Isaac Jones 2003-2004
9-- License     :  BSD3
10--
11-- Maintainer  :  cabal-devel@haskell.org
12-- Portability :  portable
13--
14-- Once a package has been configured we have resolved conditionals and
15-- dependencies, configured the compiler and other needed external programs.
16-- The 'LocalBuildInfo' is used to hold all this information. It holds the
17-- install dirs, the compiler, the exact package dependencies, the configured
18-- programs, the package database to use and a bunch of miscellaneous configure
19-- flags. It gets saved and reloaded from a file (@dist\/setup-config@). It gets
20-- passed in to very many subsequent build actions.
21
22module Distribution.Simple.LocalBuildInfo (
23        LocalBuildInfo(..),
24        localComponentId,
25        localUnitId,
26        localCompatPackageKey,
27
28        -- * Buildable package components
29        Component(..),
30        ComponentName(..),
31        LibraryName(..),
32        defaultLibName,
33        showComponentName,
34        componentNameString,
35        ComponentLocalBuildInfo(..),
36        componentBuildDir,
37        foldComponent,
38        componentName,
39        componentBuildInfo,
40        componentBuildable,
41        pkgComponents,
42        pkgBuildableComponents,
43        lookupComponent,
44        getComponent,
45        allComponentsInBuildOrder,
46        depLibraryPaths,
47        allLibModules,
48
49        withAllComponentsInBuildOrder,
50        withLibLBI,
51        withExeLBI,
52        withBenchLBI,
53        withTestLBI,
54        enabledTestLBIs,
55        enabledBenchLBIs,
56
57        -- * Installation directories
58        module Distribution.Simple.InstallDirs,
59        absoluteInstallDirs, prefixRelativeInstallDirs,
60        absoluteInstallCommandDirs,
61        absoluteComponentInstallDirs, prefixRelativeComponentInstallDirs,
62        substPathTemplate,
63  ) where
64
65import Prelude ()
66import Distribution.Compat.Prelude
67
68import Distribution.Types.Component
69import Distribution.Types.PackageId
70import Distribution.Types.UnitId
71import Distribution.Types.ComponentName
72import Distribution.Types.UnqualComponentName
73import Distribution.Types.PackageDescription
74import Distribution.Types.ComponentLocalBuildInfo
75import Distribution.Types.LocalBuildInfo
76import Distribution.Types.TargetInfo
77
78import Distribution.Simple.InstallDirs hiding (absoluteInstallDirs,
79                                               prefixRelativeInstallDirs,
80                                               substPathTemplate, )
81import qualified Distribution.Simple.InstallDirs as InstallDirs
82import Distribution.PackageDescription
83import qualified Distribution.InstalledPackageInfo as Installed
84import Distribution.Package
85import Distribution.ModuleName
86import Distribution.Simple.Compiler
87import Distribution.Simple.PackageIndex
88import Distribution.Simple.Utils
89import Distribution.Pretty
90import qualified Distribution.Compat.Graph as Graph
91
92import Data.List (stripPrefix)
93import System.FilePath
94
95import System.Directory (doesDirectoryExist, canonicalizePath)
96
97-- -----------------------------------------------------------------------------
98-- Configuration information of buildable components
99
100componentBuildDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
101-- For now, we assume that libraries/executables/test-suites/benchmarks
102-- are only ever built once.  With Backpack, we need a special case for
103-- libraries so that we can handle building them multiple times.
104componentBuildDir lbi clbi
105    = buildDir lbi </>
106        case componentLocalName clbi of
107            CLibName LMainLibName ->
108                if prettyShow (componentUnitId clbi) == prettyShow (componentComponentId clbi)
109                    then ""
110                    else prettyShow (componentUnitId clbi)
111            CLibName (LSubLibName s) ->
112                if prettyShow (componentUnitId clbi) == prettyShow (componentComponentId clbi)
113                    then unUnqualComponentName s
114                    else prettyShow (componentUnitId clbi)
115            CFLibName s  -> unUnqualComponentName s
116            CExeName s   -> unUnqualComponentName s
117            CTestName s  -> unUnqualComponentName s
118            CBenchName s -> unUnqualComponentName s
119
120-- | Perform the action on each enabled 'library' in the package
121-- description with the 'ComponentLocalBuildInfo'.
122withLibLBI :: PackageDescription -> LocalBuildInfo
123           -> (Library -> ComponentLocalBuildInfo -> IO ()) -> IO ()
124withLibLBI pkg lbi f =
125    withAllTargetsInBuildOrder' pkg lbi $ \target ->
126        case targetComponent target of
127            CLib lib -> f lib (targetCLBI target)
128            _ -> return ()
129
130-- | Perform the action on each enabled 'Executable' in the package
131-- description.  Extended version of 'withExe' that also gives corresponding
132-- build info.
133withExeLBI :: PackageDescription -> LocalBuildInfo
134           -> (Executable -> ComponentLocalBuildInfo -> IO ()) -> IO ()
135withExeLBI pkg lbi f =
136    withAllTargetsInBuildOrder' pkg lbi $ \target ->
137        case targetComponent target of
138            CExe exe -> f exe (targetCLBI target)
139            _ -> return ()
140
141-- | Perform the action on each enabled 'Benchmark' in the package
142-- description.
143withBenchLBI :: PackageDescription -> LocalBuildInfo
144            -> (Benchmark -> ComponentLocalBuildInfo -> IO ()) -> IO ()
145withBenchLBI pkg lbi f =
146    sequence_ [ f bench clbi | (bench, clbi) <- enabledBenchLBIs pkg lbi ]
147
148withTestLBI :: PackageDescription -> LocalBuildInfo
149            -> (TestSuite -> ComponentLocalBuildInfo -> IO ()) -> IO ()
150withTestLBI pkg lbi f =
151    sequence_ [ f test clbi | (test, clbi) <- enabledTestLBIs pkg lbi ]
152
153enabledTestLBIs :: PackageDescription -> LocalBuildInfo
154             -> [(TestSuite, ComponentLocalBuildInfo)]
155enabledTestLBIs pkg lbi =
156    [ (test, targetCLBI target)
157    | target <- allTargetsInBuildOrder' pkg lbi
158    , CTest test <- [targetComponent target] ]
159
160enabledBenchLBIs :: PackageDescription -> LocalBuildInfo
161             -> [(Benchmark, ComponentLocalBuildInfo)]
162enabledBenchLBIs pkg lbi =
163    [ (bench, targetCLBI target)
164    | target <- allTargetsInBuildOrder' pkg lbi
165    , CBench bench <- [targetComponent target] ]
166
167-- | Perform the action on each buildable 'Library' or 'Executable' (Component)
168-- in the PackageDescription, subject to the build order specified by the
169-- 'compBuildOrder' field of the given 'LocalBuildInfo'
170withAllComponentsInBuildOrder :: PackageDescription -> LocalBuildInfo
171                              -> (Component -> ComponentLocalBuildInfo -> IO ())
172                              -> IO ()
173withAllComponentsInBuildOrder pkg lbi f =
174    withAllTargetsInBuildOrder' pkg lbi $ \target ->
175        f (targetComponent target) (targetCLBI target)
176
177allComponentsInBuildOrder :: LocalBuildInfo
178                          -> [ComponentLocalBuildInfo]
179allComponentsInBuildOrder lbi =
180    Graph.topSort (componentGraph lbi)
181
182-- -----------------------------------------------------------------------------
183-- A random function that has no business in this module
184
185-- | Determine the directories containing the dynamic libraries of the
186-- transitive dependencies of the component we are building.
187--
188-- When wanted, and possible, returns paths relative to the installDirs 'prefix'
189depLibraryPaths :: Bool -- ^ Building for inplace?
190                -> Bool -- ^ Generate prefix-relative library paths
191                -> LocalBuildInfo
192                -> ComponentLocalBuildInfo -- ^ Component that is being built
193                -> IO [FilePath]
194depLibraryPaths inplace relative lbi clbi = do
195    let pkgDescr    = localPkgDescr lbi
196        installDirs = absoluteComponentInstallDirs pkgDescr lbi (componentUnitId clbi) NoCopyDest
197        executable  = case clbi of
198                        ExeComponentLocalBuildInfo {} -> True
199                        _                             -> False
200        relDir | executable = bindir installDirs
201               | otherwise  = libdir installDirs
202
203    let -- TODO: this is kind of inefficient
204        internalDeps = [ uid
205                       | (uid, _) <- componentPackageDeps clbi
206                       -- Test that it's internal
207                       , sub_target <- allTargetsInBuildOrder' pkgDescr lbi
208                       , componentUnitId (targetCLBI (sub_target)) == uid ]
209        internalLibs = [ getLibDir (targetCLBI sub_target)
210                       | sub_target <- neededTargetsInBuildOrder'
211                                        pkgDescr lbi internalDeps ]
212    {-
213    -- This is better, but it doesn't work, because we may be passed a
214    -- CLBI which doesn't actually exist, and was faked up when we
215    -- were building a test suite/benchmark.  See #3599 for proposal
216    -- to fix this.
217    let internalCLBIs = filter ((/= componentUnitId clbi) . componentUnitId)
218                      . map targetCLBI
219                      $ neededTargetsInBuildOrder lbi [componentUnitId clbi]
220        internalLibs = map getLibDir internalCLBIs
221    -}
222        getLibDir sub_clbi
223          | inplace    = componentBuildDir lbi sub_clbi
224          | otherwise  = dynlibdir (absoluteComponentInstallDirs pkgDescr lbi (componentUnitId sub_clbi) NoCopyDest)
225
226    -- Why do we go through all the trouble of a hand-crafting
227    -- internalLibs, when 'installedPkgs' actually contains the
228    -- internal libraries?  The trouble is that 'installedPkgs'
229    -- may contain *inplace* entries, which we must NOT use for
230    -- not inplace 'depLibraryPaths' (e.g., for RPATH calculation).
231    -- See #4025 for more details. This is all horrible but it
232    -- is a moot point if you are using a per-component build,
233    -- because you never have any internal libraries in this case;
234    -- they're all external.
235    let external_ipkgs = filter is_external (allPackages (installedPkgs lbi))
236        is_external ipkg = not (installedUnitId ipkg `elem` internalDeps)
237        -- First look for dynamic libraries in `dynamic-library-dirs`, and use
238        -- `library-dirs` as a fall back.
239        getDynDir pkg  = case Installed.libraryDynDirs pkg of
240                           [] -> Installed.libraryDirs pkg
241                           d  -> d
242        allDepLibDirs  = concatMap getDynDir external_ipkgs
243
244        allDepLibDirs' = internalLibs ++ allDepLibDirs
245    allDepLibDirsC <- traverse canonicalizePathNoFail allDepLibDirs'
246
247    let p                = prefix installDirs
248        prefixRelative l = isJust (stripPrefix p l)
249        libPaths
250          | relative &&
251            prefixRelative relDir = map (\l ->
252                                          if prefixRelative l
253                                             then shortRelativePath relDir l
254                                             else l
255                                        ) allDepLibDirsC
256          | otherwise             = allDepLibDirsC
257
258    return libPaths
259  where
260    -- 'canonicalizePath' fails on UNIX when the directory does not exists.
261    -- So just don't canonicalize when it doesn't exist.
262    canonicalizePathNoFail p = do
263      exists <- doesDirectoryExist p
264      if exists
265         then canonicalizePath p
266         else return p
267
268-- | Get all module names that needed to be built by GHC; i.e., all
269-- of these 'ModuleName's have interface files associated with them
270-- that need to be installed.
271allLibModules :: Library -> ComponentLocalBuildInfo -> [ModuleName]
272allLibModules lib clbi =
273    ordNub $
274    explicitLibModules lib ++
275    case clbi of
276        LibComponentLocalBuildInfo { componentInstantiatedWith = insts } -> map fst insts
277        _ -> []
278
279-- -----------------------------------------------------------------------------
280-- Wrappers for a couple functions from InstallDirs
281
282-- | Backwards compatibility function which computes the InstallDirs
283-- assuming that @$libname@ points to the public library (or some fake
284-- package identifier if there is no public library.)  IF AT ALL
285-- POSSIBLE, please use 'absoluteComponentInstallDirs' instead.
286absoluteInstallDirs :: PackageDescription -> LocalBuildInfo
287                    -> CopyDest
288                    -> InstallDirs FilePath
289absoluteInstallDirs pkg lbi copydest =
290    absoluteComponentInstallDirs pkg lbi (localUnitId lbi) copydest
291
292-- | See 'InstallDirs.absoluteInstallDirs'.
293absoluteComponentInstallDirs :: PackageDescription -> LocalBuildInfo
294                             -> UnitId
295                             -> CopyDest
296                             -> InstallDirs FilePath
297absoluteComponentInstallDirs pkg lbi uid copydest =
298  InstallDirs.absoluteInstallDirs
299    (packageId pkg)
300    uid
301    (compilerInfo (compiler lbi))
302    copydest
303    (hostPlatform lbi)
304    (installDirTemplates lbi)
305
306absoluteInstallCommandDirs :: PackageDescription -> LocalBuildInfo
307                           -> UnitId
308                           -> CopyDest
309                           -> InstallDirs FilePath
310absoluteInstallCommandDirs pkg lbi uid copydest =
311  dirs {
312    -- Handle files which are not
313    -- per-component (data files and Haddock files.)
314    datadir    = datadir    dirs',
315    -- NB: The situation with Haddock is a bit delicate.  On the
316    -- one hand, the easiest to understand Haddock documentation
317    -- path is pkgname-0.1, which means it's per-package (not
318    -- per-component).  But this means that it's impossible to
319    -- install Haddock documentation for internal libraries.  We'll
320    -- keep this constraint for now; this means you can't use
321    -- Cabal to Haddock internal libraries.  This does not seem
322    -- like a big problem.
323    docdir     = docdir     dirs',
324    htmldir    = htmldir    dirs',
325    haddockdir = haddockdir dirs'
326    }
327  where
328    dirs  = absoluteComponentInstallDirs pkg lbi uid copydest
329    -- Notice use of 'absoluteInstallDirs' (not the
330    -- per-component variant).  This means for non-library
331    -- packages we'll just pick a nondescriptive foo-0.1
332    dirs' = absoluteInstallDirs pkg lbi copydest
333
334-- | Backwards compatibility function which computes the InstallDirs
335-- assuming that @$libname@ points to the public library (or some fake
336-- package identifier if there is no public library.)  IF AT ALL
337-- POSSIBLE, please use 'prefixRelativeComponentInstallDirs' instead.
338prefixRelativeInstallDirs :: PackageId -> LocalBuildInfo
339                          -> InstallDirs (Maybe FilePath)
340prefixRelativeInstallDirs pkg_descr lbi =
341    prefixRelativeComponentInstallDirs pkg_descr lbi (localUnitId lbi)
342
343-- |See 'InstallDirs.prefixRelativeInstallDirs'
344prefixRelativeComponentInstallDirs :: PackageId -> LocalBuildInfo
345                                   -> UnitId
346                                   -> InstallDirs (Maybe FilePath)
347prefixRelativeComponentInstallDirs pkg_descr lbi uid =
348  InstallDirs.prefixRelativeInstallDirs
349    (packageId pkg_descr)
350    uid
351    (compilerInfo (compiler lbi))
352    (hostPlatform lbi)
353    (installDirTemplates lbi)
354
355substPathTemplate :: PackageId -> LocalBuildInfo
356                  -> UnitId
357                  -> PathTemplate -> FilePath
358substPathTemplate pkgid lbi uid = fromPathTemplate
359                                    . ( InstallDirs.substPathTemplate env )
360    where env = initialPathTemplateEnv
361                   pkgid
362                   uid
363                   (compilerInfo (compiler lbi))
364                   (hostPlatform lbi)
365
366