1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE RankNTypes #-}
4
5module Distribution.Types.LocalBuildInfo (
6    -- * The type
7
8    LocalBuildInfo(..),
9
10    -- * Convenience accessors
11
12    localComponentId,
13    localUnitId,
14    localCompatPackageKey,
15    localPackage,
16
17    -- * Build targets of the 'LocalBuildInfo'.
18
19    componentNameCLBIs,
20
21    -- NB: the primes mean that they take a 'PackageDescription'
22    -- which may not match 'localPkgDescr' in 'LocalBuildInfo'.
23    -- More logical types would drop this argument, but
24    -- at the moment, this is the ONLY supported function, because
25    -- 'localPkgDescr' is not guaranteed to match.  At some point
26    -- we will fix it and then we can use the (free) unprimed
27    -- namespace for the correct commands.
28    --
29    -- See https://github.com/haskell/cabal/issues/3606 for more
30    -- details.
31
32    componentNameTargets',
33    unitIdTarget',
34    allTargetsInBuildOrder',
35    withAllTargetsInBuildOrder',
36    neededTargetsInBuildOrder',
37    withNeededTargetsInBuildOrder',
38    testCoverage,
39
40    -- * Functions you SHOULD NOT USE (yet), but are defined here to
41    -- prevent someone from accidentally defining them
42
43    componentNameTargets,
44    unitIdTarget,
45    allTargetsInBuildOrder,
46    withAllTargetsInBuildOrder,
47    neededTargetsInBuildOrder,
48    withNeededTargetsInBuildOrder,
49  ) where
50
51import Prelude ()
52import Distribution.Compat.Prelude
53
54import Distribution.Types.PackageDescription
55import Distribution.Types.ComponentLocalBuildInfo
56import Distribution.Types.ComponentRequestedSpec
57import Distribution.Types.ComponentId
58import Distribution.Types.PackageId
59import Distribution.Types.UnitId
60import Distribution.Types.TargetInfo
61
62import Distribution.Simple.InstallDirs hiding (absoluteInstallDirs,
63                                               prefixRelativeInstallDirs,
64                                               substPathTemplate, )
65import Distribution.Simple.Program
66import Distribution.PackageDescription
67import Distribution.Simple.Compiler
68import Distribution.Simple.PackageIndex
69import Distribution.Simple.Setup
70import Distribution.System
71import Distribution.Pretty
72
73import Distribution.Compat.Graph (Graph)
74import qualified Distribution.Compat.Graph as Graph
75import qualified Data.Map as Map
76
77-- | Data cached after configuration step.  See also
78-- 'Distribution.Simple.Setup.ConfigFlags'.
79data LocalBuildInfo = LocalBuildInfo {
80        configFlags   :: ConfigFlags,
81        -- ^ Options passed to the configuration step.
82        -- Needed to re-run configuration when .cabal is out of date
83        flagAssignment :: FlagAssignment,
84        -- ^ The final set of flags which were picked for this package
85        componentEnabledSpec :: ComponentRequestedSpec,
86        -- ^ What components were enabled during configuration, and why.
87        extraConfigArgs     :: [String],
88        -- ^ Extra args on the command line for the configuration step.
89        -- Needed to re-run configuration when .cabal is out of date
90        installDirTemplates :: InstallDirTemplates,
91                -- ^ The installation directories for the various different
92                -- kinds of files
93        --TODO: inplaceDirTemplates :: InstallDirs FilePath
94        compiler      :: Compiler,
95                -- ^ The compiler we're building with
96        hostPlatform  :: Platform,
97                -- ^ The platform we're building for
98        buildDir      :: FilePath,
99                -- ^ Where to build the package.
100        cabalFilePath :: Maybe FilePath,
101                -- ^ Path to the cabal file, if given during configuration.
102        componentGraph :: Graph ComponentLocalBuildInfo,
103                -- ^ All the components to build, ordered by topological
104                -- sort, and with their INTERNAL dependencies over the
105                -- intrapackage dependency graph.
106                -- TODO: this is assumed to be short; otherwise we want
107                -- some sort of ordered map.
108        componentNameMap :: Map ComponentName [ComponentLocalBuildInfo],
109                -- ^ A map from component name to all matching
110                -- components.  These coincide with 'componentGraph'
111        installedPkgs :: InstalledPackageIndex,
112                -- ^ All the info about the installed packages that the
113                -- current package depends on (directly or indirectly).
114                -- The copy saved on disk does NOT include internal
115                -- dependencies (because we just don't have enough
116                -- information at this point to have an
117                -- 'InstalledPackageInfo' for an internal dep), but we
118                -- will often update it with the internal dependencies;
119                -- see for example 'Distribution.Simple.Build.build'.
120                -- (This admonition doesn't apply for per-component builds.)
121        pkgDescrFile  :: Maybe FilePath,
122                -- ^ the filename containing the .cabal file, if available
123        localPkgDescr :: PackageDescription,
124                -- ^ WARNING WARNING WARNING Be VERY careful about using
125                -- this function; we haven't deprecated it but using it
126                -- could introduce subtle bugs related to
127                -- 'HookedBuildInfo'.
128                --
129                -- In principle, this is supposed to contain the
130                -- resolved package description, that does not contain
131                -- any conditionals.  However, it MAY NOT contain
132                -- the description with a 'HookedBuildInfo' applied
133                -- to it; see 'HookedBuildInfo' for the whole sordid saga.
134                -- As much as possible, Cabal library should avoid using
135                -- this parameter.
136        withPrograms  :: ProgramDb, -- ^Location and args for all programs
137        withPackageDB :: PackageDBStack,  -- ^What package database to use, global\/user
138        withVanillaLib:: Bool,  -- ^Whether to build normal libs.
139        withProfLib   :: Bool,  -- ^Whether to build profiling versions of libs.
140        withSharedLib :: Bool,  -- ^Whether to build shared versions of libs.
141        withStaticLib :: Bool,  -- ^Whether to build static versions of libs (with all other libs rolled in)
142        withDynExe    :: Bool,  -- ^Whether to link executables dynamically
143        withFullyStaticExe :: Bool,  -- ^Whether to link executables fully statically
144        withProfExe   :: Bool,  -- ^Whether to build executables for profiling.
145        withProfLibDetail :: ProfDetailLevel, -- ^Level of automatic profile detail.
146        withProfExeDetail :: ProfDetailLevel, -- ^Level of automatic profile detail.
147        withOptimization :: OptimisationLevel, -- ^Whether to build with optimization (if available).
148        withDebugInfo :: DebugInfoLevel, -- ^Whether to emit debug info (if available).
149        withGHCiLib   :: Bool,  -- ^Whether to build libs suitable for use with GHCi.
150        splitSections :: Bool,  -- ^Use -split-sections with GHC, if available
151        splitObjs     :: Bool,  -- ^Use -split-objs with GHC, if available
152        stripExes     :: Bool,  -- ^Whether to strip executables during install
153        stripLibs     :: Bool,  -- ^Whether to strip libraries during install
154        exeCoverage :: Bool,  -- ^Whether to enable executable program coverage
155        libCoverage :: Bool,  -- ^Whether to enable library program coverage
156        progPrefix    :: PathTemplate, -- ^Prefix to be prepended to installed executables
157        progSuffix    :: PathTemplate, -- ^Suffix to be appended to installed executables
158        relocatable   :: Bool --  ^Whether to build a relocatable package
159  } deriving (Generic, Read, Show)
160
161instance Binary LocalBuildInfo
162
163-------------------------------------------------------------------------------
164-- Accessor functions
165
166-- TODO: Get rid of these functions, as much as possible.  They are
167-- a bit useful in some cases, but you should be very careful!
168
169-- | Extract the 'ComponentId' from the public library component of a
170-- 'LocalBuildInfo' if it exists, or make a fake component ID based
171-- on the package ID.
172localComponentId :: LocalBuildInfo -> ComponentId
173localComponentId lbi =
174    case componentNameCLBIs lbi (CLibName LMainLibName) of
175        [LibComponentLocalBuildInfo { componentComponentId = cid }]
176          -> cid
177        _ -> mkComponentId (prettyShow (localPackage lbi))
178
179-- | Extract the 'PackageIdentifier' of a 'LocalBuildInfo'.
180-- This is a "safe" use of 'localPkgDescr'
181localPackage :: LocalBuildInfo -> PackageId
182localPackage lbi = package (localPkgDescr lbi)
183
184-- | Extract the 'UnitId' from the library component of a
185-- 'LocalBuildInfo' if it exists, or make a fake unit ID based on
186-- the package ID.
187localUnitId :: LocalBuildInfo -> UnitId
188localUnitId lbi =
189    case componentNameCLBIs lbi (CLibName LMainLibName) of
190        [LibComponentLocalBuildInfo { componentUnitId = uid }]
191          -> uid
192        _ -> mkLegacyUnitId $ localPackage lbi
193
194-- | Extract the compatibility package key from the public library component of a
195-- 'LocalBuildInfo' if it exists, or make a fake package key based
196-- on the package ID.
197localCompatPackageKey :: LocalBuildInfo -> String
198localCompatPackageKey lbi =
199    case componentNameCLBIs lbi (CLibName LMainLibName) of
200        [LibComponentLocalBuildInfo { componentCompatPackageKey = pk }]
201          -> pk
202        _ -> prettyShow (localPackage lbi)
203
204-- | Convenience function to generate a default 'TargetInfo' from a
205-- 'ComponentLocalBuildInfo'.  The idea is to call this once, and then
206-- use 'TargetInfo' everywhere else.  Private to this module.
207mkTargetInfo :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> TargetInfo
208mkTargetInfo pkg_descr _lbi clbi =
209    TargetInfo {
210        targetCLBI = clbi,
211        -- NB: @pkg_descr@, not @localPkgDescr lbi@!
212        targetComponent = getComponent pkg_descr
213                                       (componentLocalName clbi)
214     }
215
216-- | Return all 'TargetInfo's associated with 'ComponentName'.
217-- In the presence of Backpack there may be more than one!
218-- Has a prime because it takes a 'PackageDescription' argument
219-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
220componentNameTargets' :: PackageDescription -> LocalBuildInfo -> ComponentName -> [TargetInfo]
221componentNameTargets' pkg_descr lbi cname =
222    case Map.lookup cname (componentNameMap lbi) of
223        Just clbis -> map (mkTargetInfo pkg_descr lbi) clbis
224        Nothing -> []
225
226unitIdTarget' :: PackageDescription -> LocalBuildInfo -> UnitId -> Maybe TargetInfo
227unitIdTarget' pkg_descr lbi uid =
228    case Graph.lookup uid (componentGraph lbi) of
229        Just clbi -> Just (mkTargetInfo pkg_descr lbi clbi)
230        Nothing -> Nothing
231
232-- | Return all 'ComponentLocalBuildInfo's associated with 'ComponentName'.
233-- In the presence of Backpack there may be more than one!
234componentNameCLBIs :: LocalBuildInfo -> ComponentName -> [ComponentLocalBuildInfo]
235componentNameCLBIs lbi cname =
236    case Map.lookup cname (componentNameMap lbi) of
237        Just clbis -> clbis
238        Nothing -> []
239
240-- TODO: Maybe cache topsort (Graph can do this)
241
242-- | Return the list of default 'TargetInfo's associated with a
243-- configured package, in the order they need to be built.
244-- Has a prime because it takes a 'PackageDescription' argument
245-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
246allTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [TargetInfo]
247allTargetsInBuildOrder' pkg_descr lbi
248    = map (mkTargetInfo pkg_descr lbi) (Graph.revTopSort (componentGraph lbi))
249
250-- | Execute @f@ for every 'TargetInfo' in the package, respecting the
251-- build dependency order.  (TODO: We should use Shake!)
252-- Has a prime because it takes a 'PackageDescription' argument
253-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
254withAllTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
255withAllTargetsInBuildOrder' pkg_descr lbi f
256    = sequence_ [ f target | target <- allTargetsInBuildOrder' pkg_descr lbi ]
257
258-- | Return the list of all targets needed to build the @uids@, in
259-- the order they need to be built.
260-- Has a prime because it takes a 'PackageDescription' argument
261-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
262neededTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
263neededTargetsInBuildOrder' pkg_descr lbi uids =
264  case Graph.closure (componentGraph lbi) uids of
265    Nothing -> error $ "localBuildPlan: missing uids " ++ intercalate ", " (map prettyShow uids)
266    Just clos -> map (mkTargetInfo pkg_descr lbi) (Graph.revTopSort (Graph.fromDistinctList clos))
267
268-- | Execute @f@ for every 'TargetInfo' needed to build @uid@s, respecting
269-- the build dependency order.
270-- Has a prime because it takes a 'PackageDescription' argument
271-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
272withNeededTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
273withNeededTargetsInBuildOrder' pkg_descr lbi uids f
274    = sequence_ [ f target | target <- neededTargetsInBuildOrder' pkg_descr lbi uids ]
275
276-- | Is coverage enabled for test suites? In practice, this requires library
277-- and executable profiling to be enabled.
278testCoverage :: LocalBuildInfo -> Bool
279testCoverage lbi = exeCoverage lbi && libCoverage lbi
280
281-------------------------------------------------------------------------------
282-- Stub functions to prevent someone from accidentally defining them
283
284{-# WARNING componentNameTargets, unitIdTarget, allTargetsInBuildOrder, withAllTargetsInBuildOrder, neededTargetsInBuildOrder, withNeededTargetsInBuildOrder "By using this function, you may be introducing a bug where you retrieve a 'Component' which does not have 'HookedBuildInfo' applied to it.  See the documentation for 'HookedBuildInfo' for an explanation of the issue.  If you have a 'PakcageDescription' handy (NOT from the 'LocalBuildInfo'), try using the primed version of the function, which takes it as an extra argument." #-}
285
286componentNameTargets :: LocalBuildInfo -> ComponentName -> [TargetInfo]
287componentNameTargets lbi = componentNameTargets' (localPkgDescr lbi) lbi
288
289unitIdTarget :: LocalBuildInfo -> UnitId -> Maybe TargetInfo
290unitIdTarget lbi = unitIdTarget' (localPkgDescr lbi) lbi
291
292allTargetsInBuildOrder :: LocalBuildInfo -> [TargetInfo]
293allTargetsInBuildOrder lbi = allTargetsInBuildOrder' (localPkgDescr lbi) lbi
294
295withAllTargetsInBuildOrder :: LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
296withAllTargetsInBuildOrder lbi = withAllTargetsInBuildOrder' (localPkgDescr lbi) lbi
297
298neededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> [TargetInfo]
299neededTargetsInBuildOrder lbi = neededTargetsInBuildOrder' (localPkgDescr lbi) lbi
300
301withNeededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
302withNeededTargetsInBuildOrder lbi = withNeededTargetsInBuildOrder' (localPkgDescr lbi) lbi
303