PackageDescription.hs 38.6 KB
Newer Older
1
{-# LANGUAGE DeriveDataTypeable #-}
simonmar's avatar
simonmar committed
2
3
-----------------------------------------------------------------------------
-- |
4
-- Module      :  Distribution.PackageDescription
ijones's avatar
ijones committed
5
-- Copyright   :  Isaac Jones 2003-2005
6
-- License     :  BSD3
7
--
Duncan Coutts's avatar
Duncan Coutts committed
8
-- Maintainer  :  cabal-devel@haskell.org
ijones's avatar
ijones committed
9
-- Portability :  portable
simonmar's avatar
simonmar committed
10
--
Duncan Coutts's avatar
Duncan Coutts committed
11
-- This defines the data structure for the @.cabal@ file format. There are
ttuegel's avatar
ttuegel committed
12
-- several parts to this structure. It has top level info and then 'Library',
13
14
15
16
-- 'Executable', 'TestSuite', and 'Benchmark' sections each of which have
-- associated 'BuildInfo' data that's used to build the library, exe, test, or
-- benchmark.  To further complicate things there is both a 'PackageDescription'
-- and a 'GenericPackageDescription'. This distinction relates to cabal
ttuegel's avatar
ttuegel committed
17
18
19
-- configurations. When we initially read a @.cabal@ file we get a
-- 'GenericPackageDescription' which has all the conditional sections.
-- Before actually building a package we have to decide
Duncan Coutts's avatar
Duncan Coutts committed
20
21
22
23
-- on each conditional. Once we've done that we get a 'PackageDescription'.
-- It was done this way initially to avoid breaking too much stuff when the
-- feature was introduced. It could probably do with being rationalised at some
-- point to make it simpler.
simonmar's avatar
simonmar committed
24

25
module Distribution.PackageDescription (
ijones's avatar
ijones committed
26
        -- * Package descriptions
ijones's avatar
ijones committed
27
28
        PackageDescription(..),
        emptyPackageDescription,
29
30
        specVersion,
        descCabalVersion,
Simon Marlow's avatar
Simon Marlow committed
31
        BuildType(..),
32
        knownBuildTypes,
Simon Marlow's avatar
Simon Marlow committed
33

34
        -- ** Libraries
ijones's avatar
ijones committed
35
        Library(..),
36
        ModuleReexport(..),
37
        emptyLibrary,
ijones's avatar
ijones committed
38
39
40
        withLib,
        hasLibs,
        libModules,
Simon Marlow's avatar
Simon Marlow committed
41

42
        -- ** Executables
ijones's avatar
ijones committed
43
        Executable(..),
44
        emptyExecutable,
ijones's avatar
ijones committed
45
        withExe,
46
        hasExes,
ijones's avatar
ijones committed
47
        exeModules,
Simon Marlow's avatar
Simon Marlow committed
48

ttuegel's avatar
ttuegel committed
49
        -- * Tests
50
        TestSuite(..),
51
        TestSuiteInterface(..),
ttuegel's avatar
ttuegel committed
52
        TestType(..),
53
54
        testType,
        knownTestTypes,
55
        emptyTestSuite,
ttuegel's avatar
ttuegel committed
56
57
58
        hasTests,
        withTest,
        testModules,
59
        enabledTests,
ttuegel's avatar
ttuegel committed
60

61
62
63
64
65
66
67
        -- * Benchmarks
        Benchmark(..),
        BenchmarkInterface(..),
        BenchmarkType(..),
        benchmarkType,
        knownBenchmarkTypes,
        emptyBenchmark,
68
69
        hasBenchmarks,
        withBenchmark,
70
        benchmarkModules,
71
        enabledBenchmarks,
72

ijones's avatar
ijones committed
73
74
75
        -- * Build information
        BuildInfo(..),
        emptyBuildInfo,
76
        allBuildInfo,
77
78
79
        allLanguages,
        allExtensions,
        usedExtensions,
80
        hcOptions,
Simon Marlow's avatar
Simon Marlow committed
81

ijones's avatar
ijones committed
82
        -- ** Supplementary build information
ijones's avatar
ijones committed
83
84
85
        HookedBuildInfo,
        emptyHookedBuildInfo,
        updatePackageDescription,
86
87
88

        -- * package configuration
        GenericPackageDescription(..),
89
90
        Flag(..), FlagName(..), FlagAssignment,
        CondTree(..), ConfVar(..), Condition(..),
91
92

        -- * Source repositories
93
94
95
96
        SourceRepo(..),
        RepoKind(..),
        RepoType(..),
        knownRepoTypes,
simonmar's avatar
simonmar committed
97
98
  ) where

99
import Data.Data   (Data)
100
import Data.List   (nub, intercalate)
EyalLotem's avatar
EyalLotem committed
101
import Data.Maybe  (fromMaybe, maybeToList)
102
import Data.Monoid (Monoid(mempty, mappend))
103
import Data.Typeable ( Typeable )
104
import Control.Monad (MonadPlus(mplus))
dterei's avatar
dterei committed
105
import Text.PrettyPrint as Disp
106
import qualified Distribution.Compat.ReadP as Parse
107
import qualified Data.Char as Char (isAlphaNum, isDigit, toLower)
simonmar's avatar
simonmar committed
108

109
import Distribution.Package
Duncan Coutts's avatar
Duncan Coutts committed
110
111
         ( PackageName(PackageName), PackageIdentifier(PackageIdentifier)
         , Dependency, Package(..) )
112
import Distribution.ModuleName ( ModuleName )
ttuegel's avatar
ttuegel committed
113
import Distribution.Version
114
115
         ( Version(Version), VersionRange, anyVersion, orLaterVersion
         , asVersionIntervals, LowerBound(..) )
116
import Distribution.License  (License(AllRightsReserved))
117
import Distribution.Compiler (CompilerFlavor)
118
import Distribution.System   (OS, Arch)
119
import Distribution.Text
120
         ( Text(..), display )
121
122
import Language.Haskell.Extension
         ( Language, Extension )
123

Simon Marlow's avatar
Simon Marlow committed
124
125
126
-- -----------------------------------------------------------------------------
-- The PackageDescription type

127
128
-- | This data type is the internal representation of the file @pkg.cabal@.
-- It contains two kinds of information about the package: information
129
130
-- which is needed for all packages, such as the package name and version, and
-- information which is needed for the simple build system only, such as
131
-- the compiler options and library name.
132
--
133
134
135
136
137
data PackageDescription
    =  PackageDescription {
        -- the following are required by all packages:
        package        :: PackageIdentifier,
        license        :: License,
Duncan Coutts's avatar
Duncan Coutts committed
138
        licenseFiles   :: [FilePath],
139
140
141
142
143
144
145
        copyright      :: String,
        maintainer     :: String,
        author         :: String,
        stability      :: String,
        testedWith     :: [(CompilerFlavor,VersionRange)],
        homepage       :: String,
        pkgUrl         :: String,
Duncan Coutts's avatar
Duncan Coutts committed
146
        bugReports     :: String,
147
        sourceRepos    :: [SourceRepo],
148
149
150
        synopsis       :: String, -- ^A one-line summary of this package
        description    :: String, -- ^A more verbose description of this package
        category       :: String,
151
152
        customFieldsPD :: [(String,String)], -- ^Custom fields starting
                                             -- with x-, stored in a
153
                                             -- simple assoc-list.
154
        buildDepends   :: [Dependency],
155
156
157
158
159
        -- | The version of the Cabal spec that this package description uses.
        -- For historical reasons this is specified with a version range but
        -- only ranges of the form @>= v@ make sense. We are in the process of
        -- transitioning to specifying just a single version, not a range.
        specVersionRaw :: Either Version VersionRange,
160
161
162
163
        buildType      :: Maybe BuildType,
        -- components
        library        :: Maybe Library,
        executables    :: [Executable],
164
        testSuites     :: [TestSuite],
165
        benchmarks     :: [Benchmark],
166
        dataFiles      :: [FilePath],
167
        dataDir        :: FilePath,
168
        extraSrcFiles  :: [FilePath],
169
        extraTmpFiles  :: [FilePath],
170
        extraDocFiles  :: [FilePath]
171
    }
172
    deriving (Show, Read, Eq, Typeable, Data)
173

174
175
176
instance Package PackageDescription where
  packageId = package

177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
-- | The version of the Cabal spec that this package should be interpreted
-- against.
--
-- Historically we used a version range but we are switching to using a single
-- version. Currently we accept either. This function converts into a single
-- version by ignoring upper bounds in the version range.
--
specVersion :: PackageDescription -> Version
specVersion pkg = case specVersionRaw pkg of
  Left  version      -> version
  Right versionRange -> case asVersionIntervals versionRange of
                          []                            -> Version [0] []
                          ((LowerBound version _, _):_) -> version

-- | The range of versions of the Cabal tools that this package is intended to
-- work with.
--
-- This function is deprecated and should not be used for new purposes, only to
-- support old packages that rely on the old interpretation.
--
descCabalVersion :: PackageDescription -> VersionRange
descCabalVersion pkg = case specVersionRaw pkg of
  Left  version      -> orLaterVersion version
  Right versionRange -> versionRange
{-# DEPRECATED descCabalVersion "Use specVersion instead" #-}

203
204
emptyPackageDescription :: PackageDescription
emptyPackageDescription
Duncan Coutts's avatar
Duncan Coutts committed
205
206
207
    =  PackageDescription {
                      package      = PackageIdentifier (PackageName "")
                                                       (Version [] []),
208
                      license      = AllRightsReserved,
Duncan Coutts's avatar
Duncan Coutts committed
209
                      licenseFiles = [],
210
                      specVersionRaw = Right anyVersion,
211
212
213
214
215
216
217
218
219
                      buildType    = Nothing,
                      copyright    = "",
                      maintainer   = "",
                      author       = "",
                      stability    = "",
                      testedWith   = [],
                      buildDepends = [],
                      homepage     = "",
                      pkgUrl       = "",
Duncan Coutts's avatar
Duncan Coutts committed
220
                      bugReports   = "",
221
                      sourceRepos  = [],
222
223
224
                      synopsis     = "",
                      description  = "",
                      category     = "",
225
                      customFieldsPD = [],
226
227
                      library      = Nothing,
                      executables  = [],
228
                      testSuites   = [],
229
                      benchmarks   = [],
230
                      dataFiles    = [],
231
                      dataDir      = "",
232
                      extraSrcFiles = [],
233
                      extraTmpFiles = [],
234
                      extraDocFiles = []
235
236
237
238
239
240
241
242
243
244
                     }

-- | The type of build system used by this package.
data BuildType
  = Simple      -- ^ calls @Distribution.Simple.defaultMain@
  | Configure   -- ^ calls @Distribution.Simple.defaultMainWithHooks defaultUserHooks@,
                -- which invokes @configure@ to generate additional build
                -- information used by later phases.
  | Make        -- ^ calls @Distribution.Make.defaultMain@
  | Custom      -- ^ uses user-supplied @Setup.hs@ or @Setup.lhs@ (default)
245
246
247
248
249
  | UnknownBuildType String
                -- ^ a package that uses an unknown build type cannot actually
                --   be built. Doing it this way rather than just giving a
                --   parse error means we get better error messages and allows
                --   you to inspect the rest of the package description.
250
                deriving (Show, Read, Eq, Typeable, Data)
251

252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
knownBuildTypes :: [BuildType]
knownBuildTypes = [Simple, Configure, Make, Custom]

instance Text BuildType where
  disp (UnknownBuildType other) = Disp.text other
  disp other                    = Disp.text (show other)

  parse = do
    name <- Parse.munch1 Char.isAlphaNum
    return $ case name of
      "Simple"    -> Simple
      "Configure" -> Configure
      "Custom"    -> Custom
      "Make"      -> Make
      _           -> UnknownBuildType name

268
269
270
271
-- ---------------------------------------------------------------------------
-- The Library type

data Library = Library {
272
        exposedModules    :: [ModuleName],
273
        reexportedModules :: [ModuleReexport],
274
        libExposed        :: Bool, -- ^ Is the lib to be exposed by default?
275
276
        libBuildInfo      :: BuildInfo
    }
277
    deriving (Show, Eq, Read, Typeable, Data)
278
279

instance Monoid Library where
280
281
  mempty = Library {
    exposedModules = mempty,
282
    reexportedModules = mempty,
283
    libExposed     = True,
284
285
286
287
    libBuildInfo   = mempty
  }
  mappend a b = Library {
    exposedModules = combine exposedModules,
288
    reexportedModules = combine reexportedModules,
289
    libExposed     = libExposed a && libExposed b, -- so False propagates
290
291
292
    libBuildInfo   = combine libBuildInfo
  }
    where combine field = field a `mappend` field b
293
294

emptyLibrary :: Library
295
emptyLibrary = mempty
296
297
298
299
300
301
302
303
304
305
306
307
308
309

-- |does this package have any libraries?
hasLibs :: PackageDescription -> Bool
hasLibs p = maybe False (buildable . libBuildInfo) (library p)

-- |'Maybe' version of 'hasLibs'
maybeHasLibs :: PackageDescription -> Maybe Library
maybeHasLibs p =
   library p >>= \lib -> if buildable (libBuildInfo lib)
                           then Just lib
                           else Nothing

-- |If the package description has a library section, call the given
--  function with the library build info as argument.
310
311
312
withLib :: PackageDescription -> (Library -> IO ()) -> IO ()
withLib pkg_descr f =
   maybe (return ()) f (maybeHasLibs pkg_descr)
313

314
-- | Get all the module names from the library (exposed and internal modules)
315
316
-- which need to be compiled.  (This does not include reexports, which
-- do not need to be compiled.)
317
318
319
libModules :: Library -> [ModuleName]
libModules lib = exposedModules lib
              ++ otherModules (libBuildInfo lib)
320

321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
-- -----------------------------------------------------------------------------
-- Module re-exports

data ModuleReexport = ModuleReexport {
       moduleReexportOriginalPackage :: Maybe PackageName,
       moduleReexportOriginalName    :: ModuleName,
       moduleReexportName            :: ModuleName
    }
    deriving (Eq, Read, Show, Typeable, Data)

instance Text ModuleReexport where
    disp (ModuleReexport mpkgname origname newname) =
          maybe Disp.empty (\pkgname -> disp pkgname <> Disp.char ':') mpkgname
       <> disp origname
      <+> if newname == origname
            then Disp.empty
            else Disp.text "as" <+> disp newname

    parse = do
      mpkgname <- Parse.option Nothing $ do
                    pkgname <- parse 
                    _       <- Parse.char ':'
                    return (Just pkgname)
      origname <- parse
      newname  <- Parse.option origname $ do
                    Parse.skipSpaces
                    _ <- Parse.string "as"
                    Parse.skipSpaces
                    parse
      return (ModuleReexport mpkgname origname newname)

352
353
354
355
356
357
358
359
-- ---------------------------------------------------------------------------
-- The Executable type

data Executable = Executable {
        exeName    :: String,
        modulePath :: FilePath,
        buildInfo  :: BuildInfo
    }
360
    deriving (Show, Read, Eq, Typeable, Data)
361
362

instance Monoid Executable where
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
  mempty = Executable {
    exeName    = mempty,
    modulePath = mempty,
    buildInfo  = mempty
  }
  mappend a b = Executable{
    exeName    = combine' exeName,
    modulePath = combine modulePath,
    buildInfo  = combine buildInfo
  }
    where combine field = field a `mappend` field b
          combine' field = case (field a, field b) of
                      ("","") -> ""
                      ("", x) -> x
                      (x, "") -> x
                      (x, y) -> error $ "Ambiguous values for executable field: '"
                                  ++ x ++ "' and '" ++ y ++ "'"
380
381

emptyExecutable :: Executable
382
emptyExecutable = mempty
383
384
385
386
387
388
389

-- |does this package have any executables?
hasExes :: PackageDescription -> Bool
hasExes p = any (buildable . buildInfo) (executables p)

-- | Perform the action on each buildable 'Executable' in the package
-- description.
390
withExe :: PackageDescription -> (Executable -> IO ()) -> IO ()
391
392
393
withExe pkg_descr f =
  sequence_ [f exe | exe <- executables pkg_descr, buildable (buildInfo exe)]

394
395
396
-- | Get all the module names from an exe
exeModules :: Executable -> [ModuleName]
exeModules exe = otherModules (buildInfo exe)
397

ttuegel's avatar
ttuegel committed
398
-- ---------------------------------------------------------------------------
399
-- The TestSuite type
ttuegel's avatar
ttuegel committed
400

401
402
-- | A \"test-suite\" stanza in a cabal file.
--
403
data TestSuite = TestSuite {
404
405
        testName      :: String,
        testInterface :: TestSuiteInterface,
406
407
408
409
410
411
412
        testBuildInfo :: BuildInfo,
        testEnabled   :: Bool
        -- TODO: By having a 'testEnabled' field in the PackageDescription, we
        -- are mixing build status information (i.e., arguments to 'configure')
        -- with static package description information. This is undesirable, but
        -- a better solution is waiting on the next overhaul to the
        -- GenericPackageDescription -> PackageDescription resolution process.
ttuegel's avatar
ttuegel committed
413
    }
414
    deriving (Show, Read, Eq, Typeable, Data)
ttuegel's avatar
ttuegel committed
415

416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
-- | The test suite interfaces that are currently defined. Each test suite must
-- specify which interface it supports.
--
-- More interfaces may be defined in future, either new revisions or totally
-- new interfaces.
--
data TestSuiteInterface =

     -- | Test interface \"exitcode-stdio-1.0\". The test-suite takes the form
     -- of an executable. It returns a zero exit code for success, non-zero for
     -- failure. The stdout and stderr channels may be logged. It takes no
     -- command line parameters and nothing on stdin.
     --
     TestSuiteExeV10 Version FilePath

     -- | Test interface \"detailed-0.9\". The test-suite takes the form of a
     -- library containing a designated module that exports \"tests :: [Test]\".
     --
   | TestSuiteLibV09 Version ModuleName

     -- | A test suite that does not conform to one of the above interfaces for
     -- the given reason (e.g. unknown test type).
     --
   | TestSuiteUnsupported TestType
440
   deriving (Eq, Read, Show, Typeable, Data)
ttuegel's avatar
ttuegel committed
441

442
443
instance Monoid TestSuite where
    mempty = TestSuite {
444
445
        testName      = mempty,
        testInterface = mempty,
446
447
        testBuildInfo = mempty,
        testEnabled   = False
ttuegel's avatar
ttuegel committed
448
449
    }

450
    mappend a b = TestSuite {
451
452
        testName      = combine' testName,
        testInterface = combine  testInterface,
453
        testBuildInfo = combine  testBuildInfo,
454
        testEnabled   = testEnabled a || testEnabled b
ttuegel's avatar
ttuegel committed
455
    }
456
457
        where combine   field = field a `mappend` field b
              combine' f = case (f a, f b) of
ttuegel's avatar
ttuegel committed
458
459
460
461
462
                        ("", x) -> x
                        (x, "") -> x
                        (x, y) -> error "Ambiguous values for test field: '"
                            ++ x ++ "' and '" ++ y ++ "'"

463
464
465
466
467
instance Monoid TestSuiteInterface where
    mempty  =  TestSuiteUnsupported (TestTypeUnknown mempty (Version [] []))
    mappend a (TestSuiteUnsupported _) = a
    mappend _ b                        = b

468
469
emptyTestSuite :: TestSuite
emptyTestSuite = mempty
ttuegel's avatar
ttuegel committed
470

471
-- | Does this package have any test suites?
ttuegel's avatar
ttuegel committed
472
hasTests :: PackageDescription -> Bool
473
hasTests = any (buildable . testBuildInfo) . testSuites
ttuegel's avatar
ttuegel committed
474

475
476
477
478
-- | Get all the enabled test suites from a package.
enabledTests :: PackageDescription -> [TestSuite]
enabledTests = filter testEnabled . testSuites

479
480
-- | Perform an action on each buildable 'TestSuite' in a package.
withTest :: PackageDescription -> (TestSuite -> IO ()) -> IO ()
481
withTest pkg_descr f =
482
    mapM_ f $ filter (buildable . testBuildInfo) $ enabledTests pkg_descr
483

484
485
-- | Get all the module names from a test suite.
testModules :: TestSuite -> [ModuleName]
486
487
488
489
testModules test = (case testInterface test of
                     TestSuiteLibV09 _ m -> [m]
                     _                   -> [])
                ++ otherModules (testBuildInfo test)
ttuegel's avatar
ttuegel committed
490

491
492
493
494
495
-- | The \"test-type\" field in the test suite stanza.
--
data TestType = TestTypeExe Version     -- ^ \"type: exitcode-stdio-x.y\"
              | TestTypeLib Version     -- ^ \"type: detailed-x.y\"
              | TestTypeUnknown String Version -- ^ Some unknown test type e.g. \"type: foo\"
496
    deriving (Show, Read, Eq, Typeable, Data)
497
498
499
500
501

knownTestTypes :: [TestType]
knownTestTypes = [ TestTypeExe (Version [1,0] [])
                 , TestTypeLib (Version [0,9] []) ]

502
503
504
505
506
stdParse :: Text ver => (ver -> String -> res) -> Parse.ReadP r res
stdParse f = do
  cs   <- Parse.sepBy1 component (Parse.char '-')
  _    <- Parse.char '-'
  ver  <- parse
507
  let name = intercalate "-" cs
508
509
510
511
512
513
514
515
  return $! f ver (lowercase name)
  where
    component = do
      cs <- Parse.munch1 Char.isAlphaNum
      if all Char.isDigit cs then Parse.pfail else return cs
      -- each component must contain an alphabetic character, to avoid
      -- ambiguity in identifiers like foo-1 (the 1 is the version number).

516
517
518
519
520
instance Text TestType where
  disp (TestTypeExe ver)          = text "exitcode-stdio-" <> disp ver
  disp (TestTypeLib ver)          = text "detailed-"       <> disp ver
  disp (TestTypeUnknown name ver) = text name <> char '-' <> disp ver

521
522
523
524
525
  parse = stdParse $ \ver name -> case name of
    "exitcode-stdio" -> TestTypeExe ver
    "detailed"       -> TestTypeLib ver
    _                -> TestTypeUnknown name ver

526
527
528
529
530
531

testType :: TestSuite -> TestType
testType test = case testInterface test of
  TestSuiteExeV10 ver _         -> TestTypeExe ver
  TestSuiteLibV09 ver _         -> TestTypeLib ver
  TestSuiteUnsupported testtype -> testtype
532

533
534
535
536
537
538
539
540
541
542
543
544
-- ---------------------------------------------------------------------------
-- The Benchmark type

-- | A \"benchmark\" stanza in a cabal file.
--
data Benchmark = Benchmark {
        benchmarkName      :: String,
        benchmarkInterface :: BenchmarkInterface,
        benchmarkBuildInfo :: BuildInfo,
        benchmarkEnabled   :: Bool
        -- TODO: See TODO for 'testEnabled'.
    }
545
    deriving (Show, Read, Eq, Typeable, Data)
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566

-- | The benchmark interfaces that are currently defined. Each
-- benchmark must specify which interface it supports.
--
-- More interfaces may be defined in future, either new revisions or
-- totally new interfaces.
--
data BenchmarkInterface =

     -- | Benchmark interface \"exitcode-stdio-1.0\". The benchmark
     -- takes the form of an executable. It returns a zero exit code
     -- for success, non-zero for failure. The stdout and stderr
     -- channels may be logged. It takes no command line parameters
     -- and nothing on stdin.
     --
     BenchmarkExeV10 Version FilePath

     -- | A benchmark that does not conform to one of the above
     -- interfaces for the given reason (e.g. unknown benchmark type).
     --
   | BenchmarkUnsupported BenchmarkType
567
   deriving (Eq, Read, Show, Typeable, Data)
568
569
570
571
572
573
574
575
576
577
578
579
580

instance Monoid Benchmark where
    mempty = Benchmark {
        benchmarkName      = mempty,
        benchmarkInterface = mempty,
        benchmarkBuildInfo = mempty,
        benchmarkEnabled   = False
    }

    mappend a b = Benchmark {
        benchmarkName      = combine' benchmarkName,
        benchmarkInterface = combine  benchmarkInterface,
        benchmarkBuildInfo = combine  benchmarkBuildInfo,
EyalLotem's avatar
EyalLotem committed
581
        benchmarkEnabled   = benchmarkEnabled a || benchmarkEnabled b
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
    }
        where combine   field = field a `mappend` field b
              combine' f = case (f a, f b) of
                        ("", x) -> x
                        (x, "") -> x
                        (x, y) -> error "Ambiguous values for benchmark field: '"
                            ++ x ++ "' and '" ++ y ++ "'"

instance Monoid BenchmarkInterface where
    mempty  =  BenchmarkUnsupported (BenchmarkTypeUnknown mempty (Version [] []))
    mappend a (BenchmarkUnsupported _) = a
    mappend _ b                        = b

emptyBenchmark :: Benchmark
emptyBenchmark = mempty

598
599
600
601
602
603
604
605
606
607
608
609
610
-- | Does this package have any benchmarks?
hasBenchmarks :: PackageDescription -> Bool
hasBenchmarks = any (buildable . benchmarkBuildInfo) . benchmarks

-- | Get all the enabled benchmarks from a package.
enabledBenchmarks :: PackageDescription -> [Benchmark]
enabledBenchmarks = filter benchmarkEnabled . benchmarks

-- | Perform an action on each buildable 'Benchmark' in a package.
withBenchmark :: PackageDescription -> (Benchmark -> IO ()) -> IO ()
withBenchmark pkg_descr f =
    mapM_ f $ filter (buildable . benchmarkBuildInfo) $ enabledBenchmarks pkg_descr

611
612
613
614
615
616
617
618
619
620
-- | Get all the module names from a benchmark.
benchmarkModules :: Benchmark -> [ModuleName]
benchmarkModules benchmark = otherModules (benchmarkBuildInfo benchmark)

-- | The \"benchmark-type\" field in the benchmark stanza.
--
data BenchmarkType = BenchmarkTypeExe Version
                     -- ^ \"type: exitcode-stdio-x.y\"
                   | BenchmarkTypeUnknown String Version
                     -- ^ Some unknown benchmark type e.g. \"type: foo\"
621
    deriving (Show, Read, Eq, Typeable, Data)
622
623
624
625
626
627
628
629

knownBenchmarkTypes :: [BenchmarkType]
knownBenchmarkTypes = [ BenchmarkTypeExe (Version [1,0] []) ]

instance Text BenchmarkType where
  disp (BenchmarkTypeExe ver)          = text "exitcode-stdio-" <> disp ver
  disp (BenchmarkTypeUnknown name ver) = text name <> char '-' <> disp ver

630
631
632
633
  parse = stdParse $ \ver name -> case name of
    "exitcode-stdio" -> BenchmarkTypeExe ver
    _                -> BenchmarkTypeUnknown name ver

634
635
636
637
638
639

benchmarkType :: Benchmark -> BenchmarkType
benchmarkType benchmark = case benchmarkInterface benchmark of
  BenchmarkExeV10 ver _              -> BenchmarkTypeExe ver
  BenchmarkUnsupported benchmarktype -> benchmarktype

640
641
642
643
644
645
646
-- ---------------------------------------------------------------------------
-- The BuildInfo type

-- Consider refactoring into executable and library versions.
data BuildInfo = BuildInfo {
        buildable         :: Bool,      -- ^ component is buildable here
        buildTools        :: [Dependency], -- ^ tools needed to build this bit
647
        cppOptions        :: [String],  -- ^ options for pre-processing Haskell code
648
649
650
651
652
        ccOptions         :: [String],  -- ^ options for C compiler
        ldOptions         :: [String],  -- ^ options for linker
        pkgconfigDepends  :: [Dependency], -- ^ pkg-config packages that are used
        frameworks        :: [String], -- ^support frameworks for Mac OS X
        cSources          :: [FilePath],
Ian D. Bollinger's avatar
Ian D. Bollinger committed
653
        hsSourceDirs      :: [FilePath], -- ^ where to look for the Haskell module hierarchy
654
        otherModules      :: [ModuleName], -- ^ non-exposed or non-main modules
655
656
657
658
659
660
661

        defaultLanguage   :: Maybe Language,-- ^ language used when not explicitly specified
        otherLanguages    :: [Language],    -- ^ other languages used within the package
        defaultExtensions :: [Extension],   -- ^ language extensions used by all modules
        otherExtensions   :: [Extension],   -- ^ other language extensions used within the package
        oldExtensions     :: [Extension],   -- ^ the old extensions field, treated same as 'defaultExtensions'

662
663
664
665
        extraLibs         :: [String], -- ^ what libraries to link with when compiling a program that uses your package
        extraLibDirs      :: [String],
        includeDirs       :: [FilePath], -- ^directories to find .h files
        includes          :: [FilePath], -- ^ The .h files to be found in includeDirs
666
        installIncludes   :: [FilePath], -- ^ .h files to install with the package
667
668
        options           :: [(CompilerFlavor,[String])],
        ghcProfOptions    :: [String],
669
        ghcSharedOptions  :: [String],
670
        customFieldsBI    :: [(String,String)], -- ^Custom fields starting
671
                                                -- with x-, stored in a
672
                                                -- simple assoc-list.
673
        targetBuildDepends :: [Dependency] -- ^ Dependencies specific to a library or executable target
674
    }
675
    deriving (Show,Read,Eq,Typeable,Data)
676

677
instance Monoid BuildInfo where
678
679
680
681
682
683
684
685
686
687
688
  mempty = BuildInfo {
    buildable         = True,
    buildTools        = [],
    cppOptions        = [],
    ccOptions         = [],
    ldOptions         = [],
    pkgconfigDepends  = [],
    frameworks        = [],
    cSources          = [],
    hsSourceDirs      = [],
    otherModules      = [],
689
690
691
692
693
    defaultLanguage   = Nothing,
    otherLanguages    = [],
    defaultExtensions = [],
    otherExtensions   = [],
    oldExtensions     = [],
694
695
696
697
698
699
700
701
    extraLibs         = [],
    extraLibDirs      = [],
    includeDirs       = [],
    includes          = [],
    installIncludes   = [],
    options           = [],
    ghcProfOptions    = [],
    ghcSharedOptions  = [],
702
703
    customFieldsBI    = [],
    targetBuildDepends = []
704
705
706
  }
  mappend a b = BuildInfo {
    buildable         = buildable a && buildable b,
707
    buildTools        = combine    buildTools,
708
709
710
    cppOptions        = combine    cppOptions,
    ccOptions         = combine    ccOptions,
    ldOptions         = combine    ldOptions,
711
    pkgconfigDepends  = combine    pkgconfigDepends,
712
713
714
715
    frameworks        = combineNub frameworks,
    cSources          = combineNub cSources,
    hsSourceDirs      = combineNub hsSourceDirs,
    otherModules      = combineNub otherModules,
716
717
718
719
720
    defaultLanguage   = combineMby defaultLanguage,
    otherLanguages    = combineNub otherLanguages,
    defaultExtensions = combineNub defaultExtensions,
    otherExtensions   = combineNub otherExtensions,
    oldExtensions     = combineNub oldExtensions,
721
722
723
724
725
726
727
728
    extraLibs         = combine    extraLibs,
    extraLibDirs      = combineNub extraLibDirs,
    includeDirs       = combineNub includeDirs,
    includes          = combineNub includes,
    installIncludes   = combineNub installIncludes,
    options           = combine    options,
    ghcProfOptions    = combine    ghcProfOptions,
    ghcSharedOptions  = combine    ghcSharedOptions,
729
730
    customFieldsBI    = combine    customFieldsBI,
    targetBuildDepends = combineNub targetBuildDepends
731
732
733
734
  }
    where
      combine    field = field a `mappend` field b
      combineNub field = nub (combine field)
735
      combineMby field = field b `mplus` field a
736

737
emptyBuildInfo :: BuildInfo
738
emptyBuildInfo = mempty
739

740
-- | The 'BuildInfo' for the library (if there is one and it's buildable), and
741
742
-- all buildable executables, test suites and benchmarks.  Useful for gathering
-- dependencies.
743
allBuildInfo :: PackageDescription -> [BuildInfo]
744
745
746
747
748
749
750
751
752
753
allBuildInfo pkg_descr = [ bi | Just lib <- [library pkg_descr]
                              , let bi = libBuildInfo lib
                              , buildable bi ]
                      ++ [ bi | exe <- executables pkg_descr
                              , let bi = buildInfo exe
                              , buildable bi ]
                      ++ [ bi | tst <- testSuites pkg_descr
                              , let bi = testBuildInfo tst
                              , buildable bi
                              , testEnabled tst ]
754
755
756
757
                      ++ [ bi | tst <- benchmarks pkg_descr
                              , let bi = benchmarkBuildInfo tst
                              , buildable bi
                              , benchmarkEnabled tst ]
758
759
  --FIXME: many of the places where this is used, we actually want to look at
  --       unbuildable bits too, probably need separate functions
760

761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
-- | The 'Language's used by this component
--
allLanguages :: BuildInfo -> [Language]
allLanguages bi = maybeToList (defaultLanguage bi)
               ++ otherLanguages bi

-- | The 'Extension's that are used somewhere by this component
--
allExtensions :: BuildInfo -> [Extension]
allExtensions bi = usedExtensions bi
                ++ otherExtensions bi

-- | The 'Extensions' that are used by all modules in this component
--
usedExtensions :: BuildInfo -> [Extension]
usedExtensions bi = oldExtensions bi
                 ++ defaultExtensions bi

779
780
781
782
type HookedBuildInfo = (Maybe BuildInfo, [(String, BuildInfo)])

emptyHookedBuildInfo :: HookedBuildInfo
emptyHookedBuildInfo = (Nothing, [])
783

784
785
786
787
788
789
-- |Select options for a particular Haskell compiler.
hcOptions :: CompilerFlavor -> BuildInfo -> [String]
hcOptions hc bi = [ opt | (hc',opts) <- options bi
                        , hc' == hc
                        , opt <- opts ]

790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
-- ------------------------------------------------------------
-- * Source repos
-- ------------------------------------------------------------

-- | Information about the source revision control system for a package.
--
-- When specifying a repo it is useful to know the meaning or intention of the
-- information as doing so enables automation. There are two obvious common
-- purposes: one is to find the repo for the latest development version, the
-- other is to find the repo for this specific release. The 'ReopKind'
-- specifies which one we mean (or another custom one).
--
-- A package can specify one or the other kind or both. Most will specify just
-- a head repo but some may want to specify a repo to reconstruct the sources
-- for this package release.
--
-- The required information is the 'RepoType' which tells us if it's using
-- 'Darcs', 'Git' for example. The 'repoLocation' and other details are
-- interpreted according to the repo type.
--
data SourceRepo = SourceRepo {
  -- | The kind of repo. This field is required.
  repoKind     :: RepoKind,

  -- | The type of the source repository system for this repo, eg 'Darcs' or
  -- 'Git'. This field is required.
  repoType     :: Maybe RepoType,

  -- | The location of the repository. For most 'RepoType's this is a URL.
  -- This field is required.
  repoLocation :: Maybe String,

  -- | 'CVS' can put multiple \"modules\" on one server and requires a
  -- module name in addition to the location to identify a particular repo.
  -- Logically this is part of the location but unfortunately has to be
  -- specified separately. This field is required for the 'CVS' 'RepoType' and
  -- should not be given otherwise.
  repoModule   :: Maybe String,

  -- | The name or identifier of the branch, if any. Many source control
  -- systems have the notion of multiple branches in a repo that exist in the
  -- same location. For example 'Git' and 'CVS' use this while systems like
  -- 'Darcs' use different locations for different branches. This field is
  -- optional but should be used if necessary to identify the sources,
  -- especially for the 'RepoThis' repo kind.
  repoBranch   :: Maybe String,

  -- | The tag identify a particular state of the repository. This should be
  -- given for the 'RepoThis' repo kind and not for 'RepoHead' kind.
  --
  repoTag      :: Maybe String,

  -- | Some repositories contain multiple projects in different subdirectories
  -- This field specifies the subdirectory where this packages sources can be
  -- found, eg the subdirectory containing the @.cabal@ file. It is interpreted
  -- relative to the root of the repository. This field is optional. If not
  -- given the default is \".\" ie no subdirectory.
  repoSubdir   :: Maybe FilePath
}
849
  deriving (Eq, Read, Show, Typeable, Data)
850
851
852
853
854
855
856
857
858
859
860
861
862
863

-- | What this repo info is for, what it represents.
--
data RepoKind =
    -- | The repository for the \"head\" or development version of the project.
    -- This repo is where we should track the latest development activity or
    -- the usual repo people should get to contribute patches.
    RepoHead

    -- | The repository containing the sources for this exact package version
    -- or release. For this kind of repo a tag should be given to give enough
    -- information to re-create the exact sources.
  | RepoThis

864
  | RepoKindUnknown String
865
  deriving (Eq, Ord, Read, Show, Typeable, Data)
866
867
868
869
870
871
872
873

-- | An enumeration of common source control systems. The fields used in the
-- 'SourceRepo' depend on the type of repo. The tools and methods used to
-- obtain and track the repo depend on the repo type.
--
data RepoType = Darcs | Git | SVN | CVS
              | Mercurial | GnuArch | Bazaar | Monotone
              | OtherRepoType String
874
  deriving (Eq, Ord, Read, Show, Typeable, Data)
875
876
877
878
879
880
881
882
883
884
885
886

knownRepoTypes :: [RepoType]
knownRepoTypes = [Darcs, Git, SVN, CVS
                 ,Mercurial, GnuArch, Bazaar, Monotone]

repoTypeAliases :: RepoType -> [String]
repoTypeAliases Bazaar    = ["bzr"]
repoTypeAliases Mercurial = ["hg"]
repoTypeAliases GnuArch   = ["arch"]
repoTypeAliases _         = []

instance Text RepoKind where
887
888
889
  disp RepoHead                = Disp.text "head"
  disp RepoThis                = Disp.text "this"
  disp (RepoKindUnknown other) = Disp.text other
890
891
892
893
894
895

  parse = do
    name <- ident
    return $ case lowercase name of
      "head" -> RepoHead
      "this" -> RepoThis
896
      _      -> RepoKindUnknown name
897
898
899
900
901
902
903
904

instance Text RepoType where
  disp (OtherRepoType other) = Disp.text other
  disp other                 = Disp.text (lowercase (show other))
  parse = fmap classifyRepoType ident

classifyRepoType :: String -> RepoType
classifyRepoType s =
EyalLotem's avatar
EyalLotem committed
905
  fromMaybe (OtherRepoType s) $ lookup (lowercase s) repoTypeMap
906
907
908
909
910
911
912
913
914
915
916
  where
    repoTypeMap = [ (name, repoType')
                  | repoType' <- knownRepoTypes
                  , name <- display repoType' : repoTypeAliases repoType' ]

ident :: Parse.ReadP r String
ident = Parse.munch1 (\c -> Char.isAlphaNum c || c == '_' || c == '-')

lowercase :: String -> String
lowercase = map Char.toLower

simonmar's avatar
simonmar committed
917
918
919
920
-- ------------------------------------------------------------
-- * Utils
-- ------------------------------------------------------------

921
922
923
924
925
926
927
updatePackageDescription :: HookedBuildInfo -> PackageDescription -> PackageDescription
updatePackageDescription (mb_lib_bi, exe_bi) p
    = p{ executables = updateExecutables exe_bi    (executables p)
       , library     = updateLibrary     mb_lib_bi (library     p)
       }
    where
      updateLibrary :: Maybe BuildInfo -> Maybe Library -> Maybe Library
928
      updateLibrary (Just bi) (Just lib) = Just (lib{libBuildInfo = bi `mappend` libBuildInfo lib})
929
      updateLibrary Nothing   mb_lib     = mb_lib
Duncan Coutts's avatar
Duncan Coutts committed
930
      updateLibrary (Just _)  Nothing    = Nothing
931
932
933
934
935

      updateExecutables :: [(String, BuildInfo)] -- ^[(exeName, new buildinfo)]
                        -> [Executable]          -- ^list of executables to update
                        -> [Executable]          -- ^list with exeNames updated
      updateExecutables exe_bi' executables' = foldr updateExecutable executables' exe_bi'
936

937
938
      updateExecutable :: (String, BuildInfo) -- ^(exeName, new buildinfo)
                       -> [Executable]        -- ^list of executables to update
Ian D. Bollinger's avatar
Ian D. Bollinger committed
939
                       -> [Executable]        -- ^list with exeName updated
940
941
      updateExecutable _                 []         = []
      updateExecutable exe_bi'@(name,bi) (exe:exes)
942
        | exeName exe == name = exe{buildInfo = bi `mappend` buildInfo exe} : exes
943
944
        | otherwise           = exe : updateExecutable exe_bi' exes

945
946
947
948
949
950
951
952
-- ---------------------------------------------------------------------------
-- The GenericPackageDescription type

data GenericPackageDescription =
    GenericPackageDescription {
        packageDescription :: PackageDescription,
        genPackageFlags       :: [Flag],
        condLibrary        :: Maybe (CondTree ConfVar [Dependency] Library),
ttuegel's avatar
ttuegel committed
953
        condExecutables    :: [(String, CondTree ConfVar [Dependency] Executable)],
954
955
        condTestSuites     :: [(String, CondTree ConfVar [Dependency] TestSuite)],
        condBenchmarks     :: [(String, CondTree ConfVar [Dependency] Benchmark)]
956
      }
957
    deriving (Show, Eq, Typeable, Data)
958

959
960
961
instance Package GenericPackageDescription where
  packageId = packageId . packageDescription

962
--TODO: make PackageDescription an instance of Text.
963
964
965
966

-- | A flag can represent a feature to be included, or a way of linking
--   a target against its dependencies, or in fact whatever you can think of.
data Flag = MkFlag
967
    { flagName        :: FlagName
968
969
    , flagDescription :: String
    , flagDefault     :: Bool
970
    , flagManual      :: Bool
971
    }
972
    deriving (Show, Eq, Typeable, Data)
973

974
975
-- | A 'FlagName' is the name of a user-defined configuration flag
newtype FlagName = FlagName String
976
    deriving (Eq, Ord, Show, Read, Typeable, Data)
977
978
979
980
981
982
983

-- | A 'FlagAssignment' is a total or partial mapping of 'FlagName's to
-- 'Bool' flag values. It represents the flags chosen by the user or
-- discovered during configuration. For example @--flags=foo --flags=-bar@
-- becomes @[("foo", True), ("bar", False)]@
--
type FlagAssignment = [(FlagName, Bool)]
984
985

-- | A @ConfVar@ represents the variable type used.
986
data ConfVar = OS OS
987
             | Arch Arch
988
             | Flag FlagName
989
             | Impl CompilerFlavor VersionRange
990
    deriving (Eq, Show, Typeable, Data)
991
992
993
994
995
996
997

-- | A boolean expression parameterized over the variable type used.
data Condition c = Var c
                 | Lit Bool
                 | CNot (Condition c)
                 | COr (Condition c) (Condition c)
                 | CAnd (Condition c) (Condition c)
998
    deriving (Show, Eq, Typeable, Data)
999
1000

data CondTree v c a = CondNode