/
PackageDescription.hs
1670 lines (1478 loc) · 65 KB
/
PackageDescription.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
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
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
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
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
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
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
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
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{-# OPTIONS -cpp #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.PackageDescription
-- Copyright : Isaac Jones 2003-2005
--
-- Maintainer : Isaac Jones <ijones@syntaxpolice.org>
-- Stability : alpha
-- Portability : portable
--
-- Package description and parsing.
{- All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Isaac Jones nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.PackageDescription (
-- * Package descriptions
PackageDescription(..),
GenericPackageDescription(..),
finalizePackageDescription,
flattenPackageDescription,
emptyPackageDescription,
readPackageDescription,
writePackageDescription,
showPackageDescription,
BuildType(..),
-- ** Libraries
Library(..),
withLib,
hasLibs,
libModules,
-- ** Executables
Executable(..),
withExe,
exeModules,
-- ** Parsing
FieldDescr(..),
LineNo,
-- ** Sanity checking
sanityCheckPackage,
-- * Build information
BuildInfo(..),
emptyBuildInfo,
mapBuildInfo,
-- ** Supplementary build information
HookedBuildInfo,
emptyHookedBuildInfo,
readHookedBuildInfo,
parseHookedBuildInfo,
writeHookedBuildInfo,
showHookedBuildInfo,
updatePackageDescription,
-- * Utilities
satisfyDependency,
ParseResult(..),
hcOptions,
autogenModuleName,
haddockName,
setupMessage,
cabalVersion,
#ifdef DEBUG
-- * Debugging
hunitTests,
test
#endif
) where
import Control.Monad(liftM, foldM, when)
import Data.Char
import Data.Maybe(isNothing, isJust, catMaybes, listToMaybe, maybeToList)
import Data.List (nub, maximumBy, unfoldr, partition)
import Text.PrettyPrint.HughesPJ as Pretty
import System.Directory(doesFileExist)
import Distribution.ParseUtils
import Distribution.Package(PackageIdentifier(..),showPackageId,
parsePackageName)
import Distribution.Version(Version(..), VersionRange(..), withinRange,
showVersion, parseVersion, showVersionRange,
parseVersionRange, isAnyVersion)
import Distribution.License(License(..))
import Distribution.Version(Dependency(..))
import Distribution.Verbosity
import Distribution.Compiler(CompilerFlavor(..))
import Distribution.Configuration
import Distribution.Simple.Utils(currentDir, die, dieWithLocation, warn)
import Language.Haskell.Extension(Extension(..))
import Distribution.Compat.ReadP as ReadP hiding (get)
import System.FilePath((<.>))
import Data.Monoid
#ifdef DEBUG
import Data.List ( sortBy )
import Test.HUnit (Test(..), assertBool, Assertion, runTestTT, Counts, assertEqual)
#endif
-- We only get our own version number when we're building with ourselves
cabalVersion :: Version
#ifdef CABAL_VERSION
cabalVersion = Version [CABAL_VERSION] []
#else
cabalVersion = error "Cabal was not bootstrapped correctly"
#endif
-- -----------------------------------------------------------------------------
-- The PackageDescription type
-- | This data type is the internal representation of the file @pkg.cabal@.
-- It contains two kinds of information about the package: information
-- 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
-- the compiler options and library name.
--
data PackageDescription
= PackageDescription {
-- the following are required by all packages:
package :: PackageIdentifier,
license :: License,
licenseFile :: FilePath,
copyright :: String,
maintainer :: String,
author :: String,
stability :: String,
testedWith :: [(CompilerFlavor,VersionRange)],
homepage :: String,
pkgUrl :: String,
synopsis :: String, -- ^A one-line summary of this package
description :: String, -- ^A more verbose description of this package
category :: String,
buildDepends :: [Dependency],
descCabalVersion :: VersionRange, -- ^If this package depends on a specific version of Cabal, give that here.
buildType :: BuildType,
-- components
library :: Maybe Library,
executables :: [Executable],
dataFiles :: [FilePath],
extraSrcFiles :: [FilePath],
extraTmpFiles :: [FilePath]
}
deriving (Show, Read, Eq)
emptyPackageDescription :: PackageDescription
emptyPackageDescription
= PackageDescription {package = PackageIdentifier "" (Version [] []),
license = AllRightsReserved,
licenseFile = "",
descCabalVersion = AnyVersion,
buildType = Custom,
copyright = "",
maintainer = "",
author = "",
stability = "",
testedWith = [],
buildDepends = [],
homepage = "",
pkgUrl = "",
synopsis = "",
description = "",
category = "",
library = Nothing,
executables = [],
dataFiles = [],
extraSrcFiles = [],
extraTmpFiles = []
}
data GenericPackageDescription =
GenericPackageDescription {
packageDescription :: PackageDescription,
genPackageFlags :: [Flag],
condLibrary :: Maybe (CondTree ConfVar [Dependency] Library),
condExecutables :: [(String, CondTree ConfVar [Dependency] Executable)]
}
--deriving (Show)
-- XXX: I think we really want a PPrint or Pretty or ShowPretty class.
instance Show GenericPackageDescription where
show (GenericPackageDescription pkg flgs mlib exes) =
showPackageDescription pkg ++ "\n" ++
(render $ vcat $ map ppFlag flgs) ++ "\n" ++
render (maybe empty (\l -> text "Library:" $+$
nest 2 (ppCondTree l showDeps)) mlib)
++ "\n" ++
(render $ vcat $
map (\(n,ct) -> (text ("Executable: " ++ n) $+$
nest 2 (ppCondTree ct showDeps))) exes)
where
ppFlag (MkFlag name desc dflt) =
(text ("Flag: " ++ name) <> colon) $+$
nest 2
((if (null desc) then empty else
text ("Description: " ++ desc)) $+$
text ("Default: " ++ show dflt))
showDeps = fsep . punctuate comma . map showDependency
data PDTagged = Lib Library | Exe String Executable | PDNull
instance Monoid PDTagged where
mempty = PDNull
PDNull `mappend` x = x
x `mappend` PDNull = x
Lib l `mappend` Lib l' = Lib (l `mappend` l')
Exe n e `mappend` Exe n' e' | n == n' = Exe n (e `mappend` e')
_ `mappend` _ = bug "Cannot combine incompatible tags"
finalizePackageDescription
:: [(String,Bool)] -- ^ Explicitly specified flag assignments
-> Maybe [PackageIdentifier] -- ^ Available dependencies
-> String -- ^ OS-name
-> String -- ^ Arch-name
-> (String, Version) -- ^ Compiler + Version
-> GenericPackageDescription
-> Either [Dependency]
(PackageDescription, [(String,Bool)])
-- ^ Either missing dependencies or the resolved package
-- description along with the flag assignments chosen.
finalizePackageDescription userflags mpkgs os arch impl
(GenericPackageDescription pkg flags mlib0 exes0) =
case resolveFlags of
Right ((mlib, exes'), deps, flagVals) ->
Right ( pkg { library = mlib
, executables = exes'
, buildDepends = nub deps
}
, flagVals )
Left missing -> Left $ nub missing
where
-- Combine lib and exes into one list of @CondTree@s with tagged data
condTrees = maybeToList (fmap (mapTreeData Lib) mlib0 )
++ map (\(name,tree) -> mapTreeData (Exe name) tree) exes0
untagRslts = foldr untag (Nothing, [])
where
untag (Lib _) (Just _, _) = bug "Only one library expected"
untag (Lib l) (Nothing, exes) = (Just l, exes)
untag (Exe n e) (mlib, exes)
| any ((== n) . fst) exes = bug "Exe with same name found"
| otherwise = (mlib, exes ++ [(n, e)])
untag PDNull x = x -- actually this should not happen, but let's be liberal
resolveFlags =
case resolveWithFlags flagChoices os arch impl condTrees check of
Right (as, ds, fs) ->
let (mlib, exes) = untagRslts as in
Right ( (fmap libFillInDefaults mlib,
map (\(n,e) -> (exeFillInDefaults e) { exeName = n }) exes),
ds, fs)
Left missing -> Left missing
flagChoices = map (\(MkFlag n _ d) -> (n, d2c n d)) flags
d2c n b = maybe [b, not b] (\x -> [x]) $ lookup n userflags
--flagDefaults = map (\(n,x:_) -> (n,x)) flagChoices
check ds = if all satisfyDep ds
then DepOk
else MissingDeps $ filter (not . satisfyDep) ds
-- if we don't know which packages are present, we just accept any
-- dependency
satisfyDep = maybe (const True)
(\pkgs -> isJust . satisfyDependency pkgs)
mpkgs
-- | Flatten a generic package description by ignoring all conditions and just
-- join the field descriptors into on package description. Note, however,
-- that this may lead to inconsistent field values, since all values are
-- joined into one field, which may not be possible in the original package
-- description, due to the use of exclusive choices (if ... else ...).
--
-- XXX: One particularly tricky case is defaulting. In the original package
-- description, e.g., the source dirctory might either be the default or a
-- certain, explicitly set path. Since defaults are filled in only after the
-- package has been resolved and when no explicit value has been set, the
-- default path will be missing from the package description returned by this
-- function.
flattenPackageDescription :: GenericPackageDescription -> PackageDescription
flattenPackageDescription (GenericPackageDescription pkg _ mlib0 exes0) =
pkg { library = mlib
, executables = reverse exes
, buildDepends = nub $ ldeps ++ reverse edeps
}
where
(mlib, ldeps) = case mlib0 of
Just lib -> let (l,ds) = ignoreConditions lib in
(Just (libFillInDefaults l), ds)
Nothing -> (Nothing, [])
(exes, edeps) = foldr flattenExe ([],[]) exes0
flattenExe (n, t) (es, ds) =
let (e, ds') = ignoreConditions t in
( (exeFillInDefaults $ e { exeName = n }) : es, ds' ++ ds )
-- | 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)
deriving (Show, Read, Eq)
-- the strings for the required fields are necessary here, and so we
-- don't repeat ourselves, I name them:
reqNameName :: String
reqNameName = "name"
reqNameVersion :: String
reqNameVersion = "version"
reqNameCopyright :: String
reqNameCopyright = "copyright"
reqNameMaintainer :: String
reqNameMaintainer = "maintainer"
reqNameSynopsis :: String
reqNameSynopsis = "synopsis"
pkgDescrFieldDescrs :: [FieldDescr PackageDescription]
pkgDescrFieldDescrs =
[ simpleField reqNameName
text parsePackageName
(pkgName . package) (\name pkg -> pkg{package=(package pkg){pkgName=name}})
, simpleField reqNameVersion
(text . showVersion) parseVersion
(pkgVersion . package) (\ver pkg -> pkg{package=(package pkg){pkgVersion=ver}})
, simpleField "cabal-version"
(text . showVersionRange) parseVersionRange
descCabalVersion (\v pkg -> pkg{descCabalVersion=v})
, simpleField "build-type"
(text . show) parseReadSQ
buildType (\t pkg -> pkg{buildType=t})
, simpleField "license"
(text . show) parseLicenseQ
license (\l pkg -> pkg{license=l})
, simpleField "license-file"
showFilePath parseFilePathQ
licenseFile (\l pkg -> pkg{licenseFile=l})
, simpleField reqNameCopyright
showFreeText (munch (const True))
copyright (\val pkg -> pkg{copyright=val})
, simpleField reqNameMaintainer
showFreeText (munch (const True))
maintainer (\val pkg -> pkg{maintainer=val})
, commaListField "build-depends"
showDependency parseDependency
buildDepends (\xs pkg -> pkg{buildDepends=xs})
, simpleField "stability"
showFreeText (munch (const True))
stability (\val pkg -> pkg{stability=val})
, simpleField "homepage"
showFreeText (munch (const True))
homepage (\val pkg -> pkg{homepage=val})
, simpleField "package-url"
showFreeText (munch (const True))
pkgUrl (\val pkg -> pkg{pkgUrl=val})
, simpleField reqNameSynopsis
showFreeText (munch (const True))
synopsis (\val pkg -> pkg{synopsis=val})
, simpleField "description"
showFreeText (munch (const True))
description (\val pkg -> pkg{description=val})
, simpleField "category"
showFreeText (munch (const True))
category (\val pkg -> pkg{category=val})
, simpleField "author"
showFreeText (munch (const True))
author (\val pkg -> pkg{author=val})
, listField "tested-with"
showTestedWith parseTestedWithQ
testedWith (\val pkg -> pkg{testedWith=val})
, listField "data-files"
showFilePath parseFilePathQ
dataFiles (\val pkg -> pkg{dataFiles=val})
, listField "extra-source-files"
showFilePath parseFilePathQ
extraSrcFiles (\val pkg -> pkg{extraSrcFiles=val})
, listField "extra-tmp-files"
showFilePath parseFilePathQ
extraTmpFiles (\val pkg -> pkg{extraTmpFiles=val})
]
-- ---------------------------------------------------------------------------
-- The Library type
data Library = Library {
exposedModules :: [String],
libBuildInfo :: BuildInfo
}
deriving (Show, Eq, Read)
instance Monoid Library where
mempty = nullLibrary
mappend = unionLibrary
emptyLibrary :: Library
emptyLibrary = Library [] emptyBuildInfo
nullLibrary :: Library
nullLibrary = Library [] nullBuildInfo
-- |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 -> toMaybe (buildable (libBuildInfo lib)) lib)
-- |If the package description has a library section, call the given
-- function with the library build info as argument.
withLib :: PackageDescription -> a -> (Library -> IO a) -> IO a
withLib pkg_descr a f =
maybe (return a) f (maybeHasLibs pkg_descr)
-- |Get all the module names from the libraries in this package
libModules :: PackageDescription -> [String]
libModules PackageDescription{library=lib}
= maybe [] exposedModules lib
++ maybe [] (otherModules . libBuildInfo) lib
libFieldDescrs :: [FieldDescr Library]
libFieldDescrs = map biToLib binfoFieldDescrs
++ [
listField "exposed-modules" text parseModuleNameQ
exposedModules (\mods lib -> lib{exposedModules=mods})
]
where biToLib = liftField libBuildInfo (\bi lib -> lib{libBuildInfo=bi})
unionLibrary :: Library -> Library -> Library
unionLibrary l1 l2 =
l1 { exposedModules = combine exposedModules
, libBuildInfo = unionBuildInfo (libBuildInfo l1) (libBuildInfo l2)
}
where combine f = f l1 ++ f l2
-- This is in fact rather a hack. The original version just overrode the
-- default values, however, when adding conditions we had to switch to a
-- modifier-based approach. There, nothing is ever overwritten, but only
-- joined together.
--
-- This is the cleanest way i could think of, that doesn't require
-- changing all field parsing functions to return modifiers instead.
libFillInDefaults :: Library -> Library
libFillInDefaults lib@(Library { libBuildInfo = bi }) =
lib { libBuildInfo = biFillInDefaults bi }
-- ---------------------------------------------------------------------------
-- The Executable type
data Executable = Executable {
exeName :: String,
modulePath :: FilePath,
buildInfo :: BuildInfo
}
deriving (Show, Read, Eq)
instance Monoid Executable where
mempty = nullExecutable
mappend = unionExecutable
emptyExecutable :: Executable
emptyExecutable = Executable {
exeName = "",
modulePath = "",
buildInfo = emptyBuildInfo
}
nullExecutable :: Executable
nullExecutable = emptyExecutable { buildInfo = nullBuildInfo }
-- note comment at libFillInDefaults
exeFillInDefaults :: Executable -> Executable
exeFillInDefaults exe@(Executable { buildInfo = bi }) =
exe { buildInfo = biFillInDefaults bi }
-- | Perform the action on each buildable 'Executable' in the package
-- description.
withExe :: PackageDescription -> (Executable -> IO a) -> IO ()
withExe pkg_descr f =
sequence_ [f exe | exe <- executables pkg_descr, buildable (buildInfo exe)]
-- |Get all the module names from the exes in this package
exeModules :: PackageDescription -> [String]
exeModules PackageDescription{executables=execs}
= concatMap (otherModules . buildInfo) execs
executableFieldDescrs :: [FieldDescr Executable]
executableFieldDescrs =
[ -- note ordering: configuration must come first, for
-- showPackageDescription.
simpleField "executable"
showToken parseTokenQ
exeName (\xs exe -> exe{exeName=xs})
, simpleField "main-is"
showFilePath parseFilePathQ
modulePath (\xs exe -> exe{modulePath=xs})
]
++ map biToExe binfoFieldDescrs
where biToExe = liftField buildInfo (\bi exe -> exe{buildInfo=bi})
unionExecutable :: Executable -> Executable -> Executable
unionExecutable e1 e2 =
e1 { exeName = combine exeName
, modulePath = combine modulePath
, buildInfo = unionBuildInfo (buildInfo e1) (buildInfo e2)
}
where combine f = case (f e1, f e2) of
("","") -> ""
("", x) -> x
(x, "") -> x
(x, y) -> error $ "Ambiguous values for executable field: '"
++ x ++ "' and '" ++ y ++ "'"
-- ---------------------------------------------------------------------------
-- The BuildInfo type
-- Consider refactoring into executable and library versions.
data BuildInfo = BuildInfo {
buildable :: Bool, -- ^ component is buildable here
ccOptions :: [String], -- ^ options for C compiler
ldOptions :: [String], -- ^ options for linker
frameworks :: [String], -- ^support frameworks for Mac OS X
cSources :: [FilePath],
hsSourceDirs :: [FilePath], -- ^ where to look for the haskell module hierarchy
otherModules :: [String], -- ^ non-exposed or non-main modules
extensions :: [Extension],
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
installIncludes :: [FilePath], -- ^ .h files to install with the package
options :: [(CompilerFlavor,[String])],
ghcProfOptions :: [String]
}
deriving (Show,Read,Eq)
nullBuildInfo :: BuildInfo
nullBuildInfo = BuildInfo {
buildable = True,
ccOptions = [],
ldOptions = [],
frameworks = [],
cSources = [],
hsSourceDirs = [],
otherModules = [],
extensions = [],
extraLibs = [],
extraLibDirs = [],
includeDirs = [],
includes = [],
installIncludes = [],
options = [],
ghcProfOptions = []
}
-- | Modify all the 'BuildInfo's in a package description.
mapBuildInfo :: (BuildInfo -> BuildInfo) ->
PackageDescription -> PackageDescription
mapBuildInfo f pkg = pkg {
library = liftM mapLibBuildInfo (library pkg),
executables = map mapExeBuildInfo (executables pkg) }
where
mapLibBuildInfo lib = lib { libBuildInfo = f (libBuildInfo lib) }
mapExeBuildInfo exe = exe { buildInfo = f (buildInfo exe) }
emptyBuildInfo :: BuildInfo
emptyBuildInfo = nullBuildInfo { hsSourceDirs = [currentDir] }
-- see comment at libFillInDefaults
biFillInDefaults :: BuildInfo -> BuildInfo
biFillInDefaults bi =
if null (hsSourceDirs bi)
then bi { hsSourceDirs = [currentDir] }
else bi
type HookedBuildInfo = (Maybe BuildInfo, [(String, BuildInfo)])
emptyHookedBuildInfo :: HookedBuildInfo
emptyHookedBuildInfo = (Nothing, [])
binfoFieldDescrs :: [FieldDescr BuildInfo]
binfoFieldDescrs =
[ simpleField "buildable"
(text . show) parseReadS
buildable (\val binfo -> binfo{buildable=val})
, listField "cc-options"
showToken parseTokenQ
ccOptions (\val binfo -> binfo{ccOptions=val})
, listField "ld-options"
showToken parseTokenQ
ldOptions (\val binfo -> binfo{ldOptions=val})
, listField "frameworks"
showToken parseTokenQ
frameworks (\val binfo -> binfo{frameworks=val})
, listField "c-sources"
showFilePath parseFilePathQ
cSources (\paths binfo -> binfo{cSources=paths})
, listField "extensions"
(text . show) parseExtensionQ
extensions (\exts binfo -> binfo{extensions=exts})
, listField "extra-libraries"
showToken parseTokenQ
extraLibs (\xs binfo -> binfo{extraLibs=xs})
, listField "extra-lib-dirs"
showFilePath parseFilePathQ
extraLibDirs (\xs binfo -> binfo{extraLibDirs=xs})
, listField "includes"
showFilePath parseFilePathQ
includes (\paths binfo -> binfo{includes=paths})
, listField "install-includes"
showFilePath parseFilePathQ
installIncludes (\paths binfo -> binfo{installIncludes=paths})
, listField "include-dirs"
showFilePath parseFilePathQ
includeDirs (\paths binfo -> binfo{includeDirs=paths})
, listField "hs-source-dirs"
showFilePath parseFilePathQ
hsSourceDirs (\paths binfo -> binfo{hsSourceDirs=paths})
, listField "other-modules"
text parseModuleNameQ
otherModules (\val binfo -> binfo{otherModules=val})
, listField "ghc-prof-options"
text parseTokenQ
ghcProfOptions (\val binfo -> binfo{ghcProfOptions=val})
, optsField "ghc-options" GHC
options (\path binfo -> binfo{options=path})
, optsField "hugs-options" Hugs
options (\path binfo -> binfo{options=path})
, optsField "nhc-options" NHC
options (\path binfo -> binfo{options=path})
, optsField "jhc-options" JHC
options (\path binfo -> binfo{options=path})
]
------------------------------------------------------------------------------
flagFieldDescrs :: [FieldDescr Flag]
flagFieldDescrs =
[ simpleField "description"
showFreeText (munch (const True))
flagDescription (\val fl -> fl{ flagDescription = val })
, simpleField "default"
(text . show) parseReadS
flagDefault (\val fl -> fl{ flagDefault = val })
]
-- ------------------------------------------------------------
-- * Utils
-- ------------------------------------------------------------
satisfyDependency :: [PackageIdentifier] -> Dependency
-> Maybe PackageIdentifier
satisfyDependency pkgs (Dependency pkgname vrange) =
case filter ok pkgs of
[] -> Nothing
qs -> Just (maximumBy versions qs)
where
ok p = pkgName p == pkgname && pkgVersion p `withinRange` vrange
versions a b = pkgVersion a `compare` pkgVersion b
-- |Update the given package description with the output from the
-- pre-hooks.
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
updateLibrary (Just bi) (Just lib) = Just (lib{libBuildInfo = unionBuildInfo bi (libBuildInfo lib)})
updateLibrary Nothing mb_lib = mb_lib
--the lib only exists in the buildinfo file. FIX: Is this
--wrong? If there aren't any exposedModules, then the library
--won't build anyway. add to sanity checker?
updateLibrary (Just bi) Nothing = Just emptyLibrary{libBuildInfo=bi}
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'
updateExecutable :: (String, BuildInfo) -- ^(exeName, new buildinfo)
-> [Executable] -- ^list of executables to update
-> [Executable] -- ^libst with exeName updated
updateExecutable _ [] = []
updateExecutable exe_bi'@(name,bi) (exe:exes)
| exeName exe == name = exe{buildInfo = unionBuildInfo bi (buildInfo exe)} : exes
| otherwise = exe : updateExecutable exe_bi' exes
unionBuildInfo :: BuildInfo -> BuildInfo -> BuildInfo
unionBuildInfo b1 b2
= b1{buildable = buildable b1 && buildable b2,
ccOptions = combine ccOptions,
ldOptions = combine ldOptions,
frameworks = combine frameworks,
cSources = combine cSources,
hsSourceDirs = combine hsSourceDirs,
otherModules = combine otherModules,
extensions = combine extensions,
extraLibs = combine extraLibs,
extraLibDirs = combine extraLibDirs,
includeDirs = combine includeDirs,
includes = combine includes,
installIncludes = combine installIncludes,
options = combine options
}
where
combine :: (Eq a) => (BuildInfo -> [a]) -> [a]
combine f = nub $ f b1 ++ f b2
-- |Select options for a particular Haskell compiler.
hcOptions :: CompilerFlavor -> [(CompilerFlavor, [String])] -> [String]
hcOptions hc hc_opts = [opt | (hc',opts) <- hc_opts, hc' == hc, opt <- opts]
-- |The name of the auto-generated module associated with a package
autogenModuleName :: PackageDescription -> String
autogenModuleName pkg_descr =
"Paths_" ++ map fixchar (pkgName (package pkg_descr))
where fixchar '-' = '_'
fixchar c = c
haddockName :: PackageDescription -> FilePath
haddockName pkg_descr = pkgName (package pkg_descr) <.> "haddock"
setupMessage :: Verbosity -> String -> PackageDescription -> IO ()
setupMessage verbosity msg pkg_descr =
when (verbosity >= normal) $
putStrLn (msg ++ ' ':showPackageId (package pkg_descr) ++ "...")
-- ---------------------------------------------------------------
-- Parsing
-- | Given a parser and a filename, return the parse of the file,
-- after checking if the file exists.
readAndParseFile :: Verbosity -> (String -> ParseResult a) -> FilePath -> IO a
readAndParseFile verbosity parser fpath = do
exists <- doesFileExist fpath
when (not exists) (die $ "Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue.")
str <- readFile fpath
case parser str of
ParseFailed e -> do
let (line, message) = locatedErrorMsg e
dieWithLocation fpath line message
ParseOk ws x -> do
mapM_ (warn verbosity) (reverse ws)
return x
readHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo
readHookedBuildInfo verbosity = readAndParseFile verbosity parseHookedBuildInfo
-- |Parse the given package file.
-- readPackageDescription :: Int -> FilePath -> IO PackageDescription
-- readPackageDescription verbosity = readAndParseFile verbosity parseDescription
readPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription
readPackageDescription verbosity =
readAndParseFile verbosity parseDescription
{-
parseDescription :: String -> ParseResult PackageDescription
parseDescription str = do
all_fields0 <- readFields str
-- detectCabalFormat all_fields0
all_fields <- mapM deprecField all_fields0
let (st:sts) = stanzas all_fields
pkg <- parseFields basic_field_descrs emptyPackageDescription st
foldM parseExtraStanza pkg sts
where
parseExtraStanza pkg st@((F _lineNo "executable" _eName):_) = do
exe <- parseFields executableFieldDescrs emptyExecutable st
return pkg{executables= executables pkg ++ [exe]}
parseExtraStanza _ x = error ("This shouldn't happen!" ++ show x)
basic_field_descrs :: [FieldDescr PackageDescription]
basic_field_descrs = pkgDescrFieldDescrs ++ map liftToPkg libFieldDescrs
where liftToPkg = liftField (fromMaybe emptyLibrary . library)
(\lib pkg -> pkg{library = Just lib})
-}
stanzas :: [Field] -> [[Field]]
stanzas [] = []
stanzas (f:fields) = (f:this) : stanzas rest
where
(this, rest) = break isStanzaHeader fields
isStanzaHeader :: Field -> Bool
isStanzaHeader (F _ f _) = f == "executable"
isStanzaHeader _ = False
------------------------------------------------------------------------------
mapSimpleFields :: (Field -> ParseResult Field) -> [Field]
-> ParseResult [Field]
mapSimpleFields f fs = mapM walk fs
where
walk fld@(F _ _ _) = f fld
walk (IfBlock l c fs1 fs2) = do
fs1' <- mapM walk fs1
fs2' <- mapM walk fs2
return (IfBlock l c fs1' fs2')
walk (Section ln n l fs1) = do
fs1' <- mapM walk fs1
return (Section ln n l fs1')
-- prop_isMapM fs = mapSimpleFields return fs == return fs
-- names of fields that represents dependencies, thus consrca
constraintFieldNames :: [String]
constraintFieldNames = ["build-depends"]
-- Possible refactoring would be to have modifiers be explicit about what
-- they add and define an accessor that specifies what the dependencies
-- are. This way we would completely reuse the parsing knowledge from the
-- field descriptor.
parseConstraint :: Field -> ParseResult [Dependency]
parseConstraint (F l n v)
| n == "build-depends" = runP l n (parseCommaList parseDependency) v
parseConstraint f = bug $ "Constraint was expected (got: " ++ show f ++ ")"
{-
headerFieldNames :: [String]
headerFieldNames = filter (\n -> not (n `elem` constraintFieldNames))
. map fieldName $ pkgDescrFieldDescrs
-}
libFieldNames :: [String]
libFieldNames = map fieldName libFieldDescrs
++ buildInfoNames ++ constraintFieldNames
-- exeFieldNames :: [String]
-- exeFieldNames = map fieldName executableFieldDescrs
-- ++ buildInfoNames
buildInfoNames :: [String]
buildInfoNames = map fieldName binfoFieldDescrs
++ map fst deprecatedFieldsBuildInfo
{-
-- Just to make the structure explicit
data CabalFile = MkCabalFile
{ headerFields :: [Field]
, cfFlags :: [Flag]
, exeFields :: [(String,CondTree ConfVar Dependency Field)]
, libFields :: CondTree ConfVar Dependency Field
} -- deriving Show
-}
-- A minimal implementation of the StateT monad transformer to avoid depending
-- on the 'mtl' package.
newtype StT s m a = StT { runStT :: s -> m (a,s) }
instance Monad m => Monad (StT s m) where
return a = StT (\s -> return (a,s))
StT f >>= g = StT $ \s -> do
(a,s') <- f s
runStT (g a) s'
get :: Monad m => StT s m s
get = StT $ \s -> return (s, s)
modify :: Monad m => (s -> s) -> StT s m ()
modify f = StT $ \s -> return ((),f s)
lift :: Monad m => m a -> StT s m a
lift m = StT $ \s -> m >>= \a -> return (a,s)
evalStT :: Monad m => StT s m a -> s -> m a
evalStT st s = runStT st s >>= return . fst
-- Our monad for parsing a list/tree of fields.
--
-- The state represents the remaining fields to be processed.
type PM a = StT [Field] ParseResult a
-- return look-ahead field or nothing if we're at the end of the file
peekField :: PM (Maybe Field)
peekField = get >>= return . listToMaybe
-- Unconditionally discard the first field in our state. Will error when it
-- reaches end of file. (Yes, that's evil.)
skipField :: PM ()
skipField = modify tail
-- | Parses the given file into a 'GenericPackageDescription'.
--
-- In Cabal 1.2 the syntax for package descriptions was changed to a format
-- with sections and possibly indented property descriptions.
parseDescription :: String -> ParseResult GenericPackageDescription
parseDescription file = do
let tabs = findIndentTabs file
fields0 <- readFields file `catchParseError` \err ->
case err of
-- In case of a TabsError report them all at once.
TabsError _ -> reportTabsError tabs
_ -> parseFail err
-- Parsing might have been successful, but if the new syntax was used with
-- tabs we can't be quite sure the parse was correct. (It is possible to
-- allow tabs in non-indented fields, but that would be inconsistent so we
-- disallow tabs as indentation alltogether.)
when (not (oldSyntax fields0) && not (null tabs)) $
reportTabsError tabs
let sf = sectionizeFields fields0
fields <- mapSimpleFields deprecField sf
flip evalStT fields $ do
hfs <- getHeader []
pkg <- lift $ parseFields pkgDescrFieldDescrs emptyPackageDescription hfs
(flags, mlib, exes) <- getBody
warnIfRest
when (not (oldSyntax fields0)) $
maybeWarnCabalVersion pkg
return (GenericPackageDescription pkg flags mlib exes)
where
oldSyntax flds = all isSimpleField flds
reportTabsError tabs =
syntaxError (fst (head tabs)) $
"Do not use tabs for indentation (use spaces instead)\n"
++ " Tabs were used at (line,column): " ++ show tabs
maybeWarnCabalVersion pkg =
when (isAnyVersion (descCabalVersion pkg)) $
lift $ warning $
"A package using section syntax should require\n"
++ "\"Cabal-Version: >= 1.2\" or equivalent."
-- "Sectionize" an old-style Cabal file. A sectionized file has:
--
-- * all global fields at the beginning, followed by
-- * all flag declarations, followed by
-- * an optional library section, and
-- * an arbitrary number of executable sections.
--
-- The current implementatition just gathers all library-specific fields
-- in a library section and wraps all executable stanzas in an executable
-- section.
sectionizeFields fs
| oldSyntax fs =
let (hdr0, exes0) = break ((=="executable") . fName) fs
(hdr, libfs0) = partition (not . (`elem` libFieldNames) . fName) hdr0
-- XXX: In traditional cabal files, dependencies are global.
-- However, we now have library dependencies and
-- per-executable dependencies, of which only the library
-- dependencies are used for flag resolution.
--
-- The right solution would be to add global dependencies to
-- each non-empty section and resolve dependencies for each.
-- The workaround, for now, is to allow library sections that
-- only consist of dependency specifications.
--
(deps, libfs1) = partition ((`elem` constraintFieldNames) . fName) libfs0
libfs = if null libfs1 && not (null deps)
-- mark library as not buildable
then [F (lineNo (head deps)) "buildable" "False"]
else libfs1