1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE RankNTypes #-}
5
6-----------------------------------------------------------------------------
7-- |
8-- Module      :  Distribution.Types.PackageDescription
9-- Copyright   :  Isaac Jones 2003-2005
10-- License     :  BSD3
11--
12-- Maintainer  :  cabal-devel@haskell.org
13-- Portability :  portable
14--
15-- This defines the data structure for the @.cabal@ file format. There are
16-- several parts to this structure. It has top level info and then 'Library',
17-- 'Executable', 'TestSuite', and 'Benchmark' sections each of which have
18-- associated 'BuildInfo' data that's used to build the library, exe, test, or
19-- benchmark.  To further complicate things there is both a 'PackageDescription'
20-- and a 'GenericPackageDescription'. This distinction relates to cabal
21-- configurations. When we initially read a @.cabal@ file we get a
22-- 'GenericPackageDescription' which has all the conditional sections.
23-- Before actually building a package we have to decide
24-- on each conditional. Once we've done that we get a 'PackageDescription'.
25-- It was done this way initially to avoid breaking too much stuff when the
26-- feature was introduced. It could probably do with being rationalised at some
27-- point to make it simpler.
28
29module Distribution.Types.PackageDescription (
30    PackageDescription(..),
31    license,
32    license',
33    buildType,
34    emptyPackageDescription,
35    hasPublicLib,
36    hasLibs,
37    allLibraries,
38    withLib,
39    hasExes,
40    withExe,
41    hasTests,
42    withTest,
43    hasBenchmarks,
44    withBenchmark,
45    hasForeignLibs,
46    withForeignLib,
47    allBuildInfo,
48    enabledBuildInfos,
49    allBuildDepends,
50    enabledBuildDepends,
51    updatePackageDescription,
52    pkgComponents,
53    pkgBuildableComponents,
54    enabledComponents,
55    lookupComponent,
56    getComponent,
57  ) where
58
59import Prelude ()
60import Distribution.Compat.Prelude
61
62import Control.Monad ((<=<))
63
64-- lens
65import qualified Distribution.Types.BuildInfo.Lens  as L
66import Distribution.Types.Library
67import Distribution.Types.TestSuite
68import Distribution.Types.Executable
69import Distribution.Types.Benchmark
70import Distribution.Types.ForeignLib
71
72import Distribution.Types.Component
73import Distribution.Types.ComponentRequestedSpec
74import Distribution.Types.Dependency
75import Distribution.Types.PackageId
76import Distribution.Types.ComponentName
77import Distribution.Types.PackageName
78import Distribution.Types.UnqualComponentName
79import Distribution.Types.SetupBuildInfo
80import Distribution.Types.BuildInfo
81import Distribution.Types.BuildType
82import Distribution.Types.SourceRepo
83import Distribution.Types.HookedBuildInfo
84
85import Distribution.CabalSpecVersion
86import Distribution.Compiler
87import Distribution.License
88import Distribution.Package
89import Distribution.Version
90import Distribution.Utils.ShortText
91
92import qualified Distribution.SPDX as SPDX
93
94-- -----------------------------------------------------------------------------
95-- The PackageDescription type
96
97-- | This data type is the internal representation of the file @pkg.cabal@.
98-- It contains two kinds of information about the package: information
99-- which is needed for all packages, such as the package name and version, and
100-- information which is needed for the simple build system only, such as
101-- the compiler options and library name.
102--
103data PackageDescription
104    =  PackageDescription {
105        -- the following are required by all packages:
106
107        -- | The version of the Cabal spec that this package description uses.
108        specVersion    :: CabalSpecVersion,
109        package        :: PackageIdentifier,
110        licenseRaw     :: Either SPDX.License License,
111        licenseFiles   :: [FilePath],
112        copyright      :: !ShortText,
113        maintainer     :: !ShortText,
114        author         :: !ShortText,
115        stability      :: !ShortText,
116        testedWith     :: [(CompilerFlavor,VersionRange)],
117        homepage       :: !ShortText,
118        pkgUrl         :: !ShortText,
119        bugReports     :: !ShortText,
120        sourceRepos    :: [SourceRepo],
121        synopsis       :: !ShortText, -- ^A one-line summary of this package
122        description    :: !ShortText, -- ^A more verbose description of this package
123        category       :: !ShortText,
124        customFieldsPD :: [(String,String)], -- ^Custom fields starting
125                                             -- with x-, stored in a
126                                             -- simple assoc-list.
127
128        -- | The original @build-type@ value as parsed from the
129        -- @.cabal@ file without defaulting. See also 'buildType'.
130        --
131        -- @since 2.2
132        buildTypeRaw   :: Maybe BuildType,
133        setupBuildInfo :: Maybe SetupBuildInfo,
134        -- components
135        library        :: Maybe Library,
136        subLibraries   :: [Library],
137        executables    :: [Executable],
138        foreignLibs    :: [ForeignLib],
139        testSuites     :: [TestSuite],
140        benchmarks     :: [Benchmark],
141        -- files
142        dataFiles      :: [FilePath],
143        dataDir        :: FilePath,
144        extraSrcFiles  :: [FilePath],
145        extraTmpFiles  :: [FilePath],
146        extraDocFiles  :: [FilePath]
147    }
148    deriving (Generic, Show, Read, Eq, Typeable, Data)
149
150instance Binary PackageDescription
151instance Structured PackageDescription
152
153instance NFData PackageDescription where rnf = genericRnf
154
155instance Package PackageDescription where
156  packageId = package
157
158-- | The SPDX 'LicenseExpression' of the package.
159--
160-- @since 2.2.0.0
161license :: PackageDescription -> SPDX.License
162license = license' . licenseRaw
163
164-- | See 'license'.
165--
166-- @since 2.2.0.0
167license' :: Either SPDX.License License -> SPDX.License
168license' = either id licenseToSPDX
169
170-- | The effective @build-type@ after applying defaulting rules.
171--
172-- The original @build-type@ value parsed is stored in the
173-- 'buildTypeRaw' field.  However, the @build-type@ field is optional
174-- and can therefore be empty in which case we need to compute the
175-- /effective/ @build-type@. This function implements the following
176-- defaulting rules:
177--
178--  * For @cabal-version:2.0@ and below, default to the @Custom@
179--    build-type unconditionally.
180--
181--  * Otherwise, if a @custom-setup@ stanza is defined, default to
182--    the @Custom@ build-type; else default to @Simple@ build-type.
183--
184-- @since 2.2
185buildType :: PackageDescription -> BuildType
186buildType pkg
187  | specVersion pkg >= CabalSpecV2_2
188    = fromMaybe newDefault (buildTypeRaw pkg)
189  | otherwise -- cabal-version < 2.1
190    = fromMaybe Custom (buildTypeRaw pkg)
191  where
192    newDefault | isNothing (setupBuildInfo pkg) = Simple
193               | otherwise                      = Custom
194
195emptyPackageDescription :: PackageDescription
196emptyPackageDescription
197    =  PackageDescription {
198                      package      = PackageIdentifier (mkPackageName "")
199                                                       nullVersion,
200                      licenseRaw   = Right UnspecifiedLicense, -- TODO:
201                      licenseFiles = [],
202                      specVersion  = CabalSpecV1_0,
203                      buildTypeRaw = Nothing,
204                      copyright    = mempty,
205                      maintainer   = mempty,
206                      author       = mempty,
207                      stability    = mempty,
208                      testedWith   = [],
209                      homepage     = mempty,
210                      pkgUrl       = mempty,
211                      bugReports   = mempty,
212                      sourceRepos  = [],
213                      synopsis     = mempty,
214                      description  = mempty,
215                      category     = mempty,
216                      customFieldsPD = [],
217                      setupBuildInfo = Nothing,
218                      library      = Nothing,
219                      subLibraries = [],
220                      foreignLibs  = [],
221                      executables  = [],
222                      testSuites   = [],
223                      benchmarks   = [],
224                      dataFiles    = [],
225                      dataDir      = ".",
226                      extraSrcFiles = [],
227                      extraTmpFiles = [],
228                      extraDocFiles = []
229                     }
230
231-- ---------------------------------------------------------------------------
232-- The Library type
233
234-- | Does this package have a buildable PUBLIC library?
235hasPublicLib :: PackageDescription -> Bool
236hasPublicLib p =
237    case library p of
238        Just lib -> buildable (libBuildInfo lib)
239        Nothing  -> False
240
241-- | Does this package have any libraries?
242hasLibs :: PackageDescription -> Bool
243hasLibs p = any (buildable . libBuildInfo) (allLibraries p)
244
245allLibraries :: PackageDescription -> [Library]
246allLibraries p = maybeToList (library p) ++ subLibraries p
247
248-- | If the package description has a buildable library section,
249-- call the given function with the library build info as argument.
250-- You probably want 'withLibLBI' if you have a 'LocalBuildInfo',
251-- see the note in
252-- "Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components"
253-- for more information.
254withLib :: PackageDescription -> (Library -> IO ()) -> IO ()
255withLib pkg_descr f =
256   sequence_ [f lib | lib <- allLibraries pkg_descr, buildable (libBuildInfo lib)]
257
258-- ---------------------------------------------------------------------------
259-- The Executable type
260
261-- |does this package have any executables?
262hasExes :: PackageDescription -> Bool
263hasExes p = any (buildable . buildInfo) (executables p)
264
265-- | Perform the action on each buildable 'Executable' in the package
266-- description.  You probably want 'withExeLBI' if you have a
267-- 'LocalBuildInfo', see the note in
268-- "Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components"
269-- for more information.
270withExe :: PackageDescription -> (Executable -> IO ()) -> IO ()
271withExe pkg_descr f =
272  sequence_ [f exe | exe <- executables pkg_descr, buildable (buildInfo exe)]
273
274-- ---------------------------------------------------------------------------
275-- The TestSuite type
276
277-- | Does this package have any test suites?
278hasTests :: PackageDescription -> Bool
279hasTests = any (buildable . testBuildInfo) . testSuites
280
281-- | Perform an action on each buildable 'TestSuite' in a package.
282-- You probably want 'withTestLBI' if you have a 'LocalBuildInfo', see the note in
283-- "Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components"
284-- for more information.
285
286withTest :: PackageDescription -> (TestSuite -> IO ()) -> IO ()
287withTest pkg_descr f =
288    sequence_ [ f test | test <- testSuites pkg_descr, buildable (testBuildInfo test) ]
289
290-- ---------------------------------------------------------------------------
291-- The Benchmark type
292
293-- | Does this package have any benchmarks?
294hasBenchmarks :: PackageDescription -> Bool
295hasBenchmarks = any (buildable . benchmarkBuildInfo) . benchmarks
296
297-- | Perform an action on each buildable 'Benchmark' in a package.
298-- You probably want 'withBenchLBI' if you have a 'LocalBuildInfo', see the note in
299-- "Distribution.Types.ComponentRequestedSpec#buildable_vs_enabled_components"
300-- for more information.
301
302withBenchmark :: PackageDescription -> (Benchmark -> IO ()) -> IO ()
303withBenchmark pkg_descr f =
304    sequence_ [f bench | bench <- benchmarks pkg_descr, buildable (benchmarkBuildInfo bench)]
305
306-- ---------------------------------------------------------------------------
307-- The ForeignLib type
308
309-- | Does this package have any foreign libraries?
310hasForeignLibs :: PackageDescription -> Bool
311hasForeignLibs p = any (buildable . foreignLibBuildInfo) (foreignLibs p)
312
313-- | Perform the action on each buildable 'ForeignLib' in the package
314-- description.
315withForeignLib :: PackageDescription -> (ForeignLib -> IO ()) -> IO ()
316withForeignLib pkg_descr f =
317  sequence_ [ f flib
318            | flib <- foreignLibs pkg_descr
319            , buildable (foreignLibBuildInfo flib)
320            ]
321
322-- ---------------------------------------------------------------------------
323-- The BuildInfo type
324
325-- | All 'BuildInfo' in the 'PackageDescription':
326-- libraries, executables, test-suites and benchmarks.
327--
328-- Useful for implementing package checks.
329allBuildInfo :: PackageDescription -> [BuildInfo]
330allBuildInfo pkg_descr = [ bi | lib <- allLibraries pkg_descr
331                               , let bi = libBuildInfo lib ]
332                       ++ [ bi | flib <- foreignLibs pkg_descr
333                               , let bi = foreignLibBuildInfo flib ]
334                       ++ [ bi | exe <- executables pkg_descr
335                               , let bi = buildInfo exe ]
336                       ++ [ bi | tst <- testSuites pkg_descr
337                               , let bi = testBuildInfo tst ]
338                       ++ [ bi | tst <- benchmarks pkg_descr
339                               , let bi = benchmarkBuildInfo tst ]
340
341-- | Return all of the 'BuildInfo's of enabled components, i.e., all of
342-- the ones that would be built if you run @./Setup build@.
343enabledBuildInfos :: PackageDescription -> ComponentRequestedSpec -> [BuildInfo]
344enabledBuildInfos pkg enabled =
345    [ componentBuildInfo comp
346    | comp <- enabledComponents pkg enabled ]
347
348
349-- ------------------------------------------------------------
350-- * Utils
351-- ------------------------------------------------------------
352
353-- | Get the combined build-depends entries of all components.
354allBuildDepends :: PackageDescription -> [Dependency]
355allBuildDepends = targetBuildDepends <=< allBuildInfo
356
357-- | Get the combined build-depends entries of all enabled components, per the
358-- given request spec.
359enabledBuildDepends :: PackageDescription -> ComponentRequestedSpec -> [Dependency]
360enabledBuildDepends spec pd = targetBuildDepends =<< enabledBuildInfos spec pd
361
362
363updatePackageDescription :: HookedBuildInfo -> PackageDescription -> PackageDescription
364updatePackageDescription (mb_lib_bi, exe_bi) p
365    = p{ executables = updateExecutables exe_bi    (executables p)
366       , library     = updateLibrary     mb_lib_bi (library     p) }
367    where
368      updateLibrary :: Maybe BuildInfo -> Maybe Library -> Maybe Library
369      updateLibrary (Just bi) (Just lib) = Just (lib{libBuildInfo = bi `mappend` libBuildInfo lib})
370      updateLibrary Nothing   mb_lib     = mb_lib
371      updateLibrary (Just _)  Nothing    = Nothing
372
373      updateExecutables :: [(UnqualComponentName, BuildInfo)] -- ^[(exeName, new buildinfo)]
374        -> [Executable]                                       -- ^list of executables to update
375        -> [Executable]                                       -- ^list with exeNames updated
376      updateExecutables exe_bi' executables' = foldr updateExecutable executables' exe_bi'
377
378      updateExecutable :: (UnqualComponentName, BuildInfo) -- ^(exeName, new buildinfo)
379                       -> [Executable]                     -- ^list of executables to update
380                       -> [Executable]                     -- ^list with exeName updated
381      updateExecutable _                 []         = []
382      updateExecutable exe_bi'@(name,bi) (exe:exes)
383        | exeName exe == name = exe{buildInfo = bi `mappend` buildInfo exe} : exes
384        | otherwise           = exe : updateExecutable exe_bi' exes
385
386-- -----------------------------------------------------------------------------
387-- Source-representation of buildable components
388
389-- | All the components in the package.
390--
391pkgComponents :: PackageDescription -> [Component]
392pkgComponents pkg =
393    [ CLib  lib | lib <- allLibraries pkg ]
394 ++ [ CFLib flib | flib <- foreignLibs pkg ]
395 ++ [ CExe  exe | exe <- executables pkg ]
396 ++ [ CTest tst | tst <- testSuites  pkg ]
397 ++ [ CBench bm | bm  <- benchmarks  pkg ]
398
399-- | A list of all components in the package that are buildable,
400-- i.e., were not marked with @buildable: False@.  This does NOT
401-- indicate if we are actually going to build the component,
402-- see 'enabledComponents' instead.
403--
404-- @since 2.0.0.2
405--
406pkgBuildableComponents :: PackageDescription -> [Component]
407pkgBuildableComponents = filter componentBuildable . pkgComponents
408
409-- | A list of all components in the package that are enabled.
410--
411-- @since 2.0.0.2
412--
413enabledComponents :: PackageDescription -> ComponentRequestedSpec -> [Component]
414enabledComponents pkg enabled = filter (componentEnabled enabled) $ pkgBuildableComponents pkg
415
416lookupComponent :: PackageDescription -> ComponentName -> Maybe Component
417lookupComponent pkg (CLibName name) =
418    fmap CLib $ find ((name ==) . libName) (allLibraries pkg)
419lookupComponent pkg (CFLibName name) =
420    fmap CFLib $ find ((name ==) . foreignLibName) (foreignLibs pkg)
421lookupComponent pkg (CExeName name) =
422    fmap CExe $ find ((name ==) . exeName) (executables pkg)
423lookupComponent pkg (CTestName name) =
424    fmap CTest $ find ((name ==) . testName) (testSuites pkg)
425lookupComponent pkg (CBenchName name) =
426    fmap CBench $ find ((name ==) . benchmarkName) (benchmarks pkg)
427
428getComponent :: PackageDescription -> ComponentName -> Component
429getComponent pkg cname =
430    case lookupComponent pkg cname of
431      Just cpnt -> cpnt
432      Nothing   -> missingComponent
433  where
434    missingComponent =
435      error $ "internal error: the package description contains no "
436           ++ "component corresponding to " ++ show cname
437
438-- -----------------------------------------------------------------------------
439-- Traversal Instances
440
441instance L.HasBuildInfos PackageDescription where
442  traverseBuildInfos f (PackageDescription a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19
443                                   x1 x2 x3 x4 x5 x6
444                                   a20 a21 a22 a23 a24) =
445    PackageDescription a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19
446        <$> (traverse . L.buildInfo) f x1 -- library
447        <*> (traverse . L.buildInfo) f x2 -- sub libraries
448        <*> (traverse . L.buildInfo) f x3 -- executables
449        <*> (traverse . L.buildInfo) f x4 -- foreign libs
450        <*> (traverse . L.buildInfo) f x5 -- test suites
451        <*> (traverse . L.buildInfo) f x6 -- benchmarks
452        <*> pure a20                      -- data files
453        <*> pure a21                      -- data dir
454        <*> pure a22                      -- extra src files
455        <*> pure a23                      -- extra temp files
456        <*> pure a24                      -- extra doc files
457