Package.hs 25 KB
Newer Older
md9ms's avatar
md9ms committed
1
{-# OPTIONS -cpp #-}
2
3
4
5
6
7
8
9
10
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Package
-- Copyright   :  Isaac Jones 2003-2004
-- 
-- Maintainer  :  Isaac Jones <ijones@syntaxpolice.org>
-- Stability   :  alpha
-- Portability :  
--
ijones's avatar
ijones committed
11
-- Explanation: Package description and parsing
12

ijones's avatar
ijones committed
13
{- All rights reserved.
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

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. -}

43
module Distribution.Package (
simonmar's avatar
simonmar committed
44
45
	PackageIdentifier(..), 
	showPackageId,
46
	PackageDescription(..),
47
48
49
50
	emptyPackageDescription,
        readPackageDescription,
        writePackageDescription,
        hasLibs,
md9ms's avatar
md9ms committed
51
        BuildInfo(..),
ka2_mail's avatar
ka2_mail committed
52
        emptyBuildInfo,
53
        Executable(..),
54
        emptyExecutable,
55
        allModules,
ijones's avatar
ijones committed
56
#ifdef DEBUG
57
        hunitTests,
ijones's avatar
ijones committed
58
        test
ijones's avatar
ijones committed
59
#endif
60
  ) where
61

62
import Control.Monad(foldM, liftM)
63
import Data.Char
64
import Data.Maybe(fromMaybe)
ka2_mail's avatar
ka2_mail committed
65
import Text.PrettyPrint.HughesPJ
ijones's avatar
ijones committed
66

67
import Distribution.Version(Version(..), VersionRange(..),
68
69
                            showVersion, parseVersion, 
                            showVersionRange, parseVersionRange)
md9ms's avatar
md9ms committed
70
import Distribution.Misc(License(..), Dependency(..), Extension(..))
md9ms's avatar
md9ms committed
71
import Distribution.Setup(CompilerFlavor(..))
72

73
import Compat.H98
ijones's avatar
ijones committed
74
import Compat.ReadP hiding (get)
ijones's avatar
ijones committed
75

ijones's avatar
ijones committed
76
#ifdef DEBUG
ijones's avatar
ijones committed
77
import HUnit (Test(..), (~:), (~=?), assertEqual, assertBool, Assertion, runTestTT)
ijones's avatar
ijones committed
78
79
#endif

80
81
data PackageIdentifier
    = PackageIdentifier {pkgName::String, pkgVersion::Version}
simonmar's avatar
simonmar committed
82
      deriving (Read, Show, Eq)
83

simonmar's avatar
simonmar committed
84
showPackageId :: PackageIdentifier -> String
ijones's avatar
ijones committed
85
showPackageId (PackageIdentifier n (Version [] _)) = n -- if no version, don't show version.
simonmar's avatar
simonmar committed
86
87
88
showPackageId pkgid = 
  pkgName pkgid ++ '-': showVersion (pkgVersion pkgid)

89

90
91
92
93
94
95
96
97
98
99
-- | This data type is the internal representation of the file @pkg.descr@.
-- 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,
100
        license        :: License,
101
102
103
        copyright      :: String,
        maintainer     :: String,
        stability      :: String,
104
        library        :: Maybe BuildInfo,
105
106
107
108
        executables    :: [Executable]
    }
    deriving (Show, Read, Eq)

109
110
111
112
113
114
115
116
117
118
emptyPackageDescription :: PackageDescription
emptyPackageDescription
    =  PackageDescription {package      = PackageIdentifier "" (Version [] []),
                      license      = AllRightsReserved,
                      copyright    = "",
                      maintainer   = "",
                      stability    = "",
                      library      = Nothing,
                      executables  = []
                     }
ijones's avatar
ijones committed
119

120
121
122
123
124
125
-- |Get all the module names from this package
allModules :: PackageDescription -> [String]
allModules PackageDescription{executables=execs, library=lib}
    = (concat $ map (\e -> modules $ buildInfo e) execs)
         ++ (maybe [] modules lib)

126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
-- |Set the name for this package. Convenience function.
setPkgName :: String -> PackageDescription -> PackageDescription
setPkgName n desc@PackageDescription{package=pkgIdent}
    = desc{package=pkgIdent{pkgName=n}}

-- |Set the version for this package. Convenience function.
setPkgVersion :: Version -> PackageDescription -> PackageDescription
setPkgVersion v desc@PackageDescription{package=pkgIdent}
    = desc{package=pkgIdent{pkgVersion=v}}

-- |does this package have any libraries?
hasLibs :: PackageDescription -> Bool
hasLibs p = case library p of
            Just l  -> if null (cSources l) && null (modules l)
                       then False else True
            Nothing -> False

            
144
145
146
147
148
149
150
151
152
153
154
155
156
157
data BuildInfo = BuildInfo {
        buildDepends    :: [Dependency],
        modules         :: [String],
	exposedModules  :: [String],
        cSources        :: [FilePath],
        hsSourceDir     :: FilePath,
        extensions      :: [Extension],
        extraLibs       :: [String],
        includeDirs     :: [FilePath],
        includes        :: [FilePath],
        options         :: [(CompilerFlavor,[String])]
    }
    deriving (Show,Read,Eq)

158
159
160
currentDir :: FilePath
currentDir = "."-- FIX: FileUtils.currentDir

161
162
163
164
165
166
emptyBuildInfo :: BuildInfo
emptyBuildInfo = BuildInfo {
                      buildDepends   = [],
                      modules        = [],
		      exposedModules = [], -- Only used for libs
		      cSources       = [],
167
		      hsSourceDir    = currentDir,
168
169
170
171
172
173
                      extensions     = [],
                      extraLibs      = [],
                      includeDirs    = [],
                      includes       = [],
                      options        = []
                     }
174
                     
175
176
177
178
-- |Add options for a specific compiler. Convenience function.
setOptions :: CompilerFlavor -> [String] -> BuildInfo -> BuildInfo
setOptions c xs desc@BuildInfo{options=opts}
    = desc{options=(c,xs):opts}
ijones's avatar
ijones committed
179

ijones's avatar
ijones committed
180

181
182
183
184
185
186
187
188
189
190
191
192
193
data Executable = Executable {
        exeName    :: String,
        modulePath :: FilePath,
        buildInfo  :: BuildInfo
    }
    deriving (Show, Read, Eq)

emptyExecutable :: Executable
emptyExecutable = Executable {
                      exeName = "",
                      modulePath = "",
                      buildInfo = emptyBuildInfo
                     }
ijones's avatar
ijones committed
194

ijones's avatar
ijones committed
195
-- ------------------------------------------------------------
196
-- * Parsing & Pretty printing
ijones's avatar
ijones committed
197
198
-- ------------------------------------------------------------

199
200
201
202
203
type LineNo = Int

data PError = AmbigousParse String LineNo
            | NoParse String LineNo
            | FromString String (Maybe LineNo)
md9ms's avatar
md9ms committed
204
205
206
        deriving Show

instance Error PError where
207
        strMsg s = FromString s Nothing
md9ms's avatar
md9ms committed
208

md9ms's avatar
md9ms committed
209
showError :: PError -> String
210
211
212
213
214
215
216
showError (AmbigousParse f n)     = "Line "++show n++": Ambigous parse in field '"++f++"'"
showError (NoParse f n)           = "Line "++show n++": Parse of field '"++f++"' failed"
showError (FromString s (Just n)) = "Line "++show n++": " ++ s
showError (FromString s Nothing)  = s

myError :: LineNo -> String -> Either PError a
myError n s = Left $ FromString s (Just n)
md9ms's avatar
md9ms committed
217

ka2_mail's avatar
ka2_mail committed
218
219
data StanzaField a 
  = StanzaField 
220
      { fieldName     :: String
ka2_mail's avatar
ka2_mail committed
221
      , fieldGet      :: a -> Doc
222
223
224
      , fieldSet      :: LineNo -> String -> a -> Either PError a
      }

ka2_mail's avatar
ka2_mail committed
225
basicStanzaFields :: [StanzaField PackageDescription]
226
227
basicStanzaFields =
 [ simpleField "name"
ka2_mail's avatar
ka2_mail committed
228
                           text                   parsePackageName
229
230
                           (pkgName . package)    (\name pkg -> pkg{package=(package pkg){pkgName=name}})
 , simpleField "version"
ka2_mail's avatar
ka2_mail committed
231
                           (text . showVersion)   parseVersion 
232
233
234
235
236
237
                           (pkgVersion . package) (\ver pkg -> pkg{package=(package pkg){pkgVersion=ver}})
 , licenseField "license" False
                           license                (\l pkg -> pkg{license=l})
 , licenseField "license-file" True
                           license                (\l pkg -> pkg{license=l})
 , simpleField "copyright"
ka2_mail's avatar
ka2_mail committed
238
                           text                   (munch (const True))
239
240
                           copyright              (\val pkg -> pkg{copyright=val})
 , simpleField "maintainer"
ka2_mail's avatar
ka2_mail committed
241
                           text                   (munch (const True))
242
243
                           maintainer             (\val pkg -> pkg{maintainer=val})
 , simpleField "stability"
ka2_mail's avatar
ka2_mail committed
244
                           text                   (munch (const True))
245
246
247
                           stability              (\val pkg -> pkg{stability=val})
 ]

ka2_mail's avatar
ka2_mail committed
248
executableStanzaFields :: [StanzaField Executable]
249
250
executableStanzaFields =
 [ simpleField "executable"
ka2_mail's avatar
ka2_mail committed
251
                           text               (munch (const True))
252
253
                           exeName            (\xs    exe -> exe{exeName=xs})
 , simpleField "main-is"
ka2_mail's avatar
ka2_mail committed
254
                           showFilePath       parseFilePath
255
256
257
                           modulePath         (\xs    exe -> exe{modulePath=xs})
 ]

ka2_mail's avatar
ka2_mail committed
258
binfoFields :: [StanzaField BuildInfo]
259
260
261
262
263
binfoFields =
 [ listField   "build-depends"   
                           showDependency     parseDependency
                           buildDepends       (\xs    binfo -> binfo{buildDepends=xs})
 , listField   "modules"         
ka2_mail's avatar
ka2_mail committed
264
                           text               parseModuleName
265
266
                           modules            (\xs    binfo -> binfo{modules=xs})
 , listField   "exposed-modules"
ka2_mail's avatar
ka2_mail committed
267
                           text               parseModuleName
268
269
                           exposedModules     (\xs    binfo -> binfo{exposedModules=xs})
 , listField   "c-sources"
ka2_mail's avatar
ka2_mail committed
270
                           showFilePath       parseFilePath
271
272
                           cSources           (\paths binfo -> binfo{cSources=paths})
 , listField   "extensions"
ka2_mail's avatar
ka2_mail committed
273
                           (text . show)      parseExtension
274
275
                           extensions         (\exts  binfo -> binfo{extensions=exts})
 , listField   "extra-libs"
ka2_mail's avatar
ka2_mail committed
276
                           text               parseLibName
277
278
                           extraLibs          (\xs    binfo -> binfo{extraLibs=xs})
 , listField   "includes"
ka2_mail's avatar
ka2_mail committed
279
                           showFilePath       parseFilePath
280
                           includes           (\paths binfo -> binfo{includes=paths})
ka2_mail's avatar
ka2_mail committed
281
282
283
 , listField   "include-dirs"
                           showFilePath       parseFilePath
                           includes           (\paths binfo -> binfo{includeDirs=paths})
284
 , simpleField "hs-source-dir"
ka2_mail's avatar
ka2_mail committed
285
                           showFilePath       parseFilePath
286
287
288
289
290
291
292
293
294
                           hsSourceDir        (\path  binfo -> binfo{hsSourceDir=path})
 , optsField   "options-ghc"  GHC
                           options            (\path  binfo -> binfo{options=path})
 , optsField   "options-hugs" Hugs
                           options            (\path  binfo -> binfo{options=path})
 , optsField   "options-nhc"  NHC
                           options            (\path  binfo -> binfo{options=path})
 ]

ka2_mail's avatar
ka2_mail committed
295
296
297
simpleField :: String -> (a -> Doc) -> (ReadP a a) -> (b -> a) -> (a -> b -> b) -> StanzaField b
simpleField name showF readF get set = StanzaField name
   (\st -> text name <> colon <+> showF (get st))
298
299
300
301
   (\lineNo val st -> do
       x <- runP lineNo name readF val
       return (set x st))

ka2_mail's avatar
ka2_mail committed
302
303
listField :: String -> (a -> Doc) -> (ReadP [a] a) -> (b -> [a]) -> ([a] -> b -> b) -> StanzaField b
listField name showF readF get set = StanzaField name
304
   (\st -> case get st of
ka2_mail's avatar
ka2_mail committed
305
        [] -> empty
306
        (value:values) ->
ka2_mail's avatar
ka2_mail committed
307
           text name <> vcat (               colon <+> showF value:
ijones's avatar
ijones committed
308
                              map (\value' -> comma <+> showF value') values))
309
310
311
312
   (\lineNo val st -> do
       xs <- runP lineNo name (parseCommaList readF) val
       return (set xs st))

ka2_mail's avatar
ka2_mail committed
313
314
licenseField :: String -> Bool -> (b -> License) -> (License -> b -> b) -> StanzaField b
licenseField name flag get set = StanzaField name
315
   (\st -> case get st of
ka2_mail's avatar
ka2_mail committed
316
317
             OtherLicense path | flag      -> text name <> colon <+> showFilePath path
                               | otherwise -> empty
ijones's avatar
ijones committed
318
             license'          | not flag  -> text name <> colon <+> text (show license')
ka2_mail's avatar
ka2_mail committed
319
                               | otherwise -> empty)
320
321
322
323
324
325
326
327
328
   (\lineNo val st ->
       if flag 
         then do 
            path <- runP lineNo name parseFilePath val
            return (set (OtherLicense path) st)
         else do
            x <- runP lineNo name parseLicense val
            return (set x st))

ka2_mail's avatar
ka2_mail committed
329
330
optsField :: String -> CompilerFlavor -> (b -> [(CompilerFlavor,[String])]) -> ([(CompilerFlavor,[String])] -> b -> b) -> StanzaField b
optsField name flavor get set = StanzaField name
331
   (\st -> case lookup flavor (get st) of
ka2_mail's avatar
ka2_mail committed
332
333
        Just args -> text name <> colon <+> hsep (map text args)
        Nothing   -> empty)
ijones's avatar
ijones committed
334
   (\_ val st -> 
335
336
337
338
339
340
341
342
343
344
345
346
347
       let
         old_val  = get st
         old_args = case lookup flavor old_val of
                       Just args -> args
                       Nothing   -> []
         val'     = filter (\(f,_) -> f/=flavor) old_val
       in return (set ((flavor,words val++old_args) : val') st))

-- --------------------------------------------
-- ** Parsing

-- |Parse the given package file.
readPackageDescription :: FilePath -> IO PackageDescription
ka2_mail's avatar
ka2_mail committed
348
349
readPackageDescription fpath = do 
  str <- readFile fpath
350
351
352
353
354
  case parseDescription str of
    Left  e -> error (showError e) -- FIXME
    Right PackageDescription{library=Nothing, executables=[]} -> error "no library listed, and no executable stanza."
    Right x -> return x

md9ms's avatar
md9ms committed
355
parseDescription :: String -> Either PError PackageDescription
356
parseDescription inp = do let (st:sts) = splitStanzas inp
357
                          pkg <- foldM (parseBasicStanza basicStanzaFields) emptyPackageDescription st
358
359
360
                          exes <- mapM parseExecutableStanza sts
                          return pkg{executables=exes}
  where -- The basic stanza, with library building info
ijones's avatar
ijones committed
361
        parseBasicStanza ((StanzaField name _ set):fields) pkg (lineNo, f, val)
362
363
364
365
366
367
368
          | name == f = set lineNo val pkg
          | otherwise = parseBasicStanza fields pkg (lineNo, f, val)
        parseBasicStanza [] pkg (lineNo, f, val) = do
          let lib = fromMaybe emptyBuildInfo (library pkg)
	  lib' <- parseBInfoField binfoFields lib (lineNo, f, val)
          return pkg{library=Just lib'}

ijones's avatar
ijones committed
369
        parseExecutableStanza st@((_, "executable",eName):_) =
370
          case lookupField "main-is" st of
ijones's avatar
ijones committed
371
	    Just (_,_) -> foldM (parseExecutableField executableStanzaFields) emptyExecutable st
372
373
374
	    Nothing           -> fail $ "No 'Main-Is' field found for " ++ eName ++ " stanza"
        parseExecutableStanza ((lineNo, f,_):_) = 
          myError lineNo $ "'Executable' stanza starting with field '" ++ f ++ "'"
md9ms's avatar
md9ms committed
375
        parseExecutableStanza _ = error "This shouldn't happen!"
376

ijones's avatar
ijones committed
377
        parseExecutableField ((StanzaField name _ set):fields) exe (lineNo, f, val)
378
379
380
381
382
383
	  | name == f = set lineNo val exe
	  | otherwise = parseExecutableField fields exe (lineNo, f, val)
	parseExecutableField [] exe (lineNo, f, val) = do
	  binfo <- parseBInfoField binfoFields (buildInfo exe) (lineNo, f, val)
          return exe{buildInfo=binfo}

ijones's avatar
ijones committed
384
        parseBInfoField ((StanzaField name _ set):fields) binfo (lineNo, f, val)
385
386
	  | name == f = set lineNo val binfo
	  | otherwise = parseBInfoField fields binfo (lineNo, f, val)
ijones's avatar
ijones committed
387
	parseBInfoField [] _ (lineNo, f, _) =
388
	  myError lineNo $ "Unknown field '" ++ f ++ "'"
md9ms's avatar
md9ms committed
389
        -- ...
390
        lookupField :: String -> Stanza -> Maybe (LineNo,String)
ijones's avatar
ijones committed
391
        lookupField _ [] = Nothing
392
393
394
395
        lookupField x ((n,f,v):st)
          | x == f      = Just (n,v)
          | otherwise   = lookupField x st

396

397
398
399
400
401
runP :: LineNo -> String -> ReadP a a -> String -> Either PError a
runP lineNo field p s =
  case [ x | (x,"") <- results ] of
    [a] -> Right a
    []  -> case [ x | (x,ys) <- results, all isSpace ys ] of
402
             [a] -> Right a
403
404
405
406
             []  -> Left (NoParse field lineNo)
             _   -> Left (AmbigousParse field lineNo)
    _   -> Left (AmbigousParse field lineNo)
  where results = readP_to_S p s
407

408
409
type Stanza = [(LineNo,String,String)]

410
411
412
-- |Split a string into blank line-separated stanzas of
-- "Field: value" groups
splitStanzas :: String -> [Stanza]
413
414
415
416
417
418
splitStanzas = map merge . groupStanzas . filter validLine . zip [1..] . lines
  where validLine (_,s) = case dropWhile isSpace s of
                            '-':'-':_ -> False      -- Comment
                            _         -> True
        allSpaces (_,xs) = all isSpace xs
        groupStanzas :: [(Int,String)] -> [[(Int,String)]]
419
        groupStanzas [] = []
420
421
422
        groupStanzas xs = let (ys,zs) = break allSpaces xs
                           in ys : groupStanzas (dropWhile allSpaces zs)
        merge ((n,x):(_,' ':s):ys) = case dropWhile isSpace s of
423
424
                                       ('.':s') -> merge ((n,x++"\n"++s'):ys)
                                       s'       -> merge ((n,x++"\n"++s'):ys)
425
426
427
428
        merge ((n,x):ys) = brk n x : merge ys
        merge []         = []
        brk n xs = case break (==':') xs of
                     (fld, ':':val) -> (n, map toLower fld, dropWhile isSpace val)
ijones's avatar
ijones committed
429
                     (_, _)       -> error $ "Line "++show n++": Invalid syntax (no colon after field name)"
ijones's avatar
ijones committed
430

431
-- |parse a module name
432
parseModuleName :: ReadP r String
md9ms's avatar
md9ms committed
433
434
435
parseModuleName = do c <- satisfy isUpper
                     cs <- munch (\x -> isAlphaNum x || x `elem` "_'.")
                     return (c:cs)
436
437
438
439

parseFilePath :: ReadP r FilePath
parseFilePath = parseReadS <++ (munch1 (\x -> isAlphaNum x || x `elem` "-+/_."))

ka2_mail's avatar
ka2_mail committed
440
441
442
443
444
445
showFilePath :: FilePath -> Doc
showFilePath fpath
	| all (\x -> isAlphaNum x || x `elem` "-+/_.") fpath = text fpath
	| otherwise = doubleQuotes (text fpath)


446
447
448
parseReadS :: Read a => ReadP r a
parseReadS = readS_to_P reads

449
450
451
452
453
parsePackageName :: ReadP r String
parsePackageName = do n <- satisfy isAlpha
                      name <- munch1 (\x -> isAlphaNum x || x `elem` "-")
                      return (n:name)

454
parseDependency :: ReadP r Dependency
455
parseDependency = do name <- parsePackageName
456
457
458
                     skipSpaces
                     ver <- parseVersionRange <++ return AnyVersion
                     skipSpaces
459
460
                     return $ Dependency name ver

461
parseLicense :: ReadP r License
462
parseLicense = parseReadS
ijones's avatar
ijones committed
463

464
parseExtension :: ReadP r Extension
md9ms's avatar
md9ms committed
465
parseExtension = parseReadS
md9ms's avatar
md9ms committed
466

md9ms's avatar
md9ms committed
467
468
parseLibName :: ReadP r String
parseLibName = munch1 (\x -> not (isSpace x) && x /= ',')
ijones's avatar
ijones committed
469

470
471
472
parseCommaList :: ReadP r a -- ^The parser for the stuff between commas
               -> ReadP r [a]
parseCommaList p = sepBy1 p separator
ka2_mail's avatar
ka2_mail committed
473
    where separator = skipSpaces >> Compat.ReadP.char ',' >> skipSpaces
ijones's avatar
ijones committed
474
475


476
477
478
479
480

-- --------------------------------------------
-- ** Pretty printing

writePackageDescription :: FilePath -> PackageDescription -> IO ()
ka2_mail's avatar
ka2_mail committed
481
482
483
484
485
486
487
488
489
writePackageDescription fpath pkg = writeFile fpath (showPackageDescription pkg)

showPackageDescription :: PackageDescription -> String
showPackageDescription pkg = render $
  ppFields pkg basicStanzaFields $$
  (case library pkg of
     Nothing  -> empty
     Just lib -> ppFields lib binfoFields) $$
  vcat (map ppExecutable (executables pkg))
490
  where
ka2_mail's avatar
ka2_mail committed
491
492
493
494
495
    ppExecutable exe =
      space $$
      ppFields exe executableStanzaFields $$
      ppFields (buildInfo exe) binfoFields

ijones's avatar
ijones committed
496
497
498
    ppFields _ [] = empty
    ppFields pkg' ((StanzaField _ get _):flds) =
           get pkg' $$ ppFields pkg' flds
499
        
ka2_mail's avatar
ka2_mail committed
500
501
showDependency :: Dependency -> Doc
showDependency (Dependency name ver) = text name <+> text (showVersionRange ver)
502

ijones's avatar
ijones committed
503
504
505
506
-- ------------------------------------------------------------
-- * Testing
-- ------------------------------------------------------------
#ifdef DEBUG
507
508
509
510
511
512
513
514
515
testPkgDesc = unlines [
        "-- Required",
        "Name: Cabal",
        "Version: 0.1.1.1.1-rain",
        "License: LGPL",
        "Copyright: Free Text String",
        "-- Optional - may be in source?",
        "Stability: Free Text String",
        "Build-Depends: haskell-src, HUnit>=1.0.0-rain",
516
517
        "Modules: Distribution.Package, Distribution.Version,",
        "         Distribution.Simple.GHCPackageConfig",
518
519
520
        "C-Sources: not/even/rain.c, such/small/hands",
        "HS-Source-Dir: src",
        "Exposed-Modules: Distribution.Void, Foo.Bar",
md9ms's avatar
md9ms committed
521
        "Extensions: OverlappingInstances, TypeSynonymInstances",
522
523
        "Extra-Libs: libfoo, bar, bang",
        "Include-Dirs: your/slightest, look/will",
md9ms's avatar
md9ms committed
524
        "Includes: /easily/unclose, /me, \"funky, path\\\\name\"",
525
        "Options-ghc: -fTH -fglasgow-exts",
526
527
528
529
        "Options-hugs: +TH",
        "",
        "-- Next is an executable",
        "Executable: somescript",
530
        "Main-is: SomeFile.hs",
531
532
533
        "Modules: Foo1, Util, Main",
        "HS-Source-Dir: scripts",
        "Extensions: OverlappingInstances"
534
        ]
ijones's avatar
ijones committed
535
536
537

testPkgDescAnswer = 
 PackageDescription {package = PackageIdentifier {pkgName = "Cabal",
ijones's avatar
ijones committed
538
                                                 pkgVersion = Version {versionBranch = [0,1,1,1,1],
md9ms's avatar
md9ms committed
539
                                                 versionTags = ["rain"]}},
ijones's avatar
ijones committed
540
                    license = LGPL,
ijones's avatar
ijones committed
541
                    copyright = "Free Text String",
ijones's avatar
ijones committed
542
                    maintainer = "",
ijones's avatar
ijones committed
543
                    stability = "Free Text String",
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559

                    library = Just $ BuildInfo {
                        buildDepends = [Dependency "haskell-src" AnyVersion,
                                        Dependency "HUnit"
                                         (UnionVersionRanges (ThisVersion (Version [1,0,0] ["rain"]))
                                          (LaterVersion (Version [1,0,0] ["rain"])))],

                        modules = ["Distribution.Package","Distribution.Version",
                                      "Distribution.Simple.GHCPackageConfig"],

                        cSources = ["not/even/rain.c", "such/small/hands"],
                        hsSourceDir = "src",
                        exposedModules = ["Distribution.Void", "Foo.Bar"],
                        extensions = [OverlappingInstances, TypeSynonymInstances],
                        extraLibs = ["libfoo", "bar", "bang"],
                        includeDirs = ["your/slightest", "look/will"],
md9ms's avatar
md9ms committed
560
                        includes = ["/easily/unclose", "/me", "funky, path\\name"],
561
562
                        -- Note reversed order:
                        options = [(Hugs,["+TH"]), (GHC,["-fTH","-fglasgow-exts"])]
563
                    },
564
565
                    executables = [Executable "somescript" "SomeFile.hs" (
                      emptyBuildInfo{
566
567
568
569
                        modules = ["Foo1","Util","Main"],
                        hsSourceDir = "scripts",
                        extensions = [OverlappingInstances]
                      })]
ijones's avatar
ijones committed
570
571
}

ijones's avatar
ijones committed
572
hunitTests :: [Test]
573
hunitTests = [
md9ms's avatar
md9ms committed
574
575
              TestLabel "license parsers" $ TestCase $
                 sequence_ [assertRight ("license " ++ show lVal) lVal
576
                                        (runP 1 "license" parseLicense (show lVal))
md9ms's avatar
md9ms committed
577
                           | lVal <- [GPL,LGPL,BSD3,BSD4]],
ijones's avatar
ijones committed
578
579
580
581

              TestLabel "Required fields" $ TestCase $
                 do assertRight "some fields"
                       emptyPackageDescription{package=(PackageIdentifier "foo"
md9ms's avatar
md9ms committed
582
                                                        (Version [0,0] ["asdf"]))}
ijones's avatar
ijones committed
583
584
585
586
                       (parseDescription "Name: foo\nVersion: 0.0-asdf")

                    assertRight "more fields foo"
                       emptyPackageDescription{package=(PackageIdentifier "foo"
md9ms's avatar
md9ms committed
587
                                                        (Version [0,0]["asdf"])),
ijones's avatar
ijones committed
588
589
590
591
592
                                               license=GPL}
                       (parseDescription "Name: foo\nVersion:0.0-asdf\nLicense: GPL")

                    assertRight "required fields for foo"
                       emptyPackageDescription{package=(PackageIdentifier "foo"
md9ms's avatar
md9ms committed
593
                                                        (Version [0,0]["asdf"])),
ijones's avatar
ijones committed
594
595
596
                                        license=GPL, copyright="2004 isaac jones"}
                       (parseDescription "Name: foo\nVersion:0.0-asdf\nCopyright: 2004 isaac jones\nLicense: GPL"),
                                          
597
             TestCase $ assertRight "no library" Nothing
598
                        (library `liftM` parseDescription "Name: foo\nVersion: 1\nLicense: GPL\nMaintainer: someone\n\nExecutable: script\nMain-is: SomeFile.hs\n"),
ijones's avatar
ijones committed
599
600
601
602

             TestLabel "Package description" $ TestCase $ 
                assertRight "entire package description" testPkgDescAnswer
                                                         (parseDescription testPkgDesc)
md9ms's avatar
md9ms committed
603

ijones's avatar
ijones committed
604
605
             ]

ijones's avatar
ijones committed
606

ijones's avatar
ijones committed
607
608
609
610
611
612
613
614
615
616
assertRight :: (Eq val) => String -> val -> (Either a val) -> Assertion
assertRight mes expected actual
    =  assertBool mes
           (case actual of
             (Right v) -> v == expected
             _         -> False)

isError (Left _) = True
isError _        = False

ijones's avatar
ijones committed
617
test = runTestTT (TestList hunitTests)
ijones's avatar
ijones committed
618
#endif