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