Package.hs 24.7 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,
ijones's avatar
ijones committed
55
#ifdef DEBUG
56
        hunitTests,
ijones's avatar
ijones committed
57
        test
ijones's avatar
ijones committed
58
#endif
59
  ) where
60

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

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

72
import Compat.H98
73
import Compat.ReadP
ijones's avatar
ijones committed
74

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

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

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

88

89
90
91
92
93
94
95
96
97
98
-- | 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,
99
        license        :: License,
100
101
102
        copyright      :: String,
        maintainer     :: String,
        stability      :: String,
103
        library        :: Maybe BuildInfo,
104
105
106
107
        executables    :: [Executable]
    }
    deriving (Show, Read, Eq)

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

119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
-- |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

            
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
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)

emptyBuildInfo :: BuildInfo
emptyBuildInfo = BuildInfo {
                      buildDepends   = [],
                      modules        = [],
		      exposedModules = [], -- Only used for libs
		      cSources       = [],
		      hsSourceDir    = ".", -- FIX: FileUtils.currentDir
                      extensions     = [],
                      extraLibs      = [],
                      includeDirs    = [],
                      includes       = [],
                      options        = []
                     }
164
                     
165
166
167
168
-- |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
169

ijones's avatar
ijones committed
170

171
172
173
174
175
176
177
178
179
180
181
182
183
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
184

ijones's avatar
ijones committed
185
-- ------------------------------------------------------------
186
-- * Parsing & Pretty printing
ijones's avatar
ijones committed
187
188
-- ------------------------------------------------------------

189
190
191
192
193
type LineNo = Int

data PError = AmbigousParse String LineNo
            | NoParse String LineNo
            | FromString String (Maybe LineNo)
md9ms's avatar
md9ms committed
194
195
196
        deriving Show

instance Error PError where
197
        strMsg s = FromString s Nothing
md9ms's avatar
md9ms committed
198

md9ms's avatar
md9ms committed
199
showError :: PError -> String
200
201
202
203
204
205
206
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
207

ka2_mail's avatar
ka2_mail committed
208
209
data StanzaField a 
  = StanzaField 
210
      { fieldName     :: String
ka2_mail's avatar
ka2_mail committed
211
      , fieldGet      :: a -> Doc
212
213
214
      , fieldSet      :: LineNo -> String -> a -> Either PError a
      }

ka2_mail's avatar
ka2_mail committed
215
basicStanzaFields :: [StanzaField PackageDescription]
216
217
basicStanzaFields =
 [ simpleField "name"
ka2_mail's avatar
ka2_mail committed
218
                           text                   parsePackageName
219
220
                           (pkgName . package)    (\name pkg -> pkg{package=(package pkg){pkgName=name}})
 , simpleField "version"
ka2_mail's avatar
ka2_mail committed
221
                           (text . showVersion)   parseVersion 
222
223
224
225
226
227
                           (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
228
                           text                   (munch (const True))
229
230
                           copyright              (\val pkg -> pkg{copyright=val})
 , simpleField "maintainer"
ka2_mail's avatar
ka2_mail committed
231
                           text                   (munch (const True))
232
233
                           maintainer             (\val pkg -> pkg{maintainer=val})
 , simpleField "stability"
ka2_mail's avatar
ka2_mail committed
234
                           text                   (munch (const True))
235
236
237
                           stability              (\val pkg -> pkg{stability=val})
 ]

ka2_mail's avatar
ka2_mail committed
238
executableStanzaFields :: [StanzaField Executable]
239
240
executableStanzaFields =
 [ simpleField "executable"
ka2_mail's avatar
ka2_mail committed
241
                           text               (munch (const True))
242
243
                           exeName            (\xs    exe -> exe{exeName=xs})
 , simpleField "main-is"
ka2_mail's avatar
ka2_mail committed
244
                           showFilePath       parseFilePath
245
246
247
                           modulePath         (\xs    exe -> exe{modulePath=xs})
 ]

ka2_mail's avatar
ka2_mail committed
248
binfoFields :: [StanzaField BuildInfo]
249
250
251
252
253
binfoFields =
 [ listField   "build-depends"   
                           showDependency     parseDependency
                           buildDepends       (\xs    binfo -> binfo{buildDepends=xs})
 , listField   "modules"         
ka2_mail's avatar
ka2_mail committed
254
                           text               parseModuleName
255
256
                           modules            (\xs    binfo -> binfo{modules=xs})
 , listField   "exposed-modules"
ka2_mail's avatar
ka2_mail committed
257
                           text               parseModuleName
258
259
                           exposedModules     (\xs    binfo -> binfo{exposedModules=xs})
 , listField   "c-sources"
ka2_mail's avatar
ka2_mail committed
260
                           showFilePath       parseFilePath
261
262
                           cSources           (\paths binfo -> binfo{cSources=paths})
 , listField   "extensions"
ka2_mail's avatar
ka2_mail committed
263
                           (text . show)      parseExtension
264
265
                           extensions         (\exts  binfo -> binfo{extensions=exts})
 , listField   "extra-libs"
ka2_mail's avatar
ka2_mail committed
266
                           text               parseLibName
267
268
                           extraLibs          (\xs    binfo -> binfo{extraLibs=xs})
 , listField   "includes"
ka2_mail's avatar
ka2_mail committed
269
                           showFilePath       parseFilePath
270
                           includes           (\paths binfo -> binfo{includes=paths})
ka2_mail's avatar
ka2_mail committed
271
272
273
 , listField   "include-dirs"
                           showFilePath       parseFilePath
                           includes           (\paths binfo -> binfo{includeDirs=paths})
274
 , simpleField "hs-source-dir"
ka2_mail's avatar
ka2_mail committed
275
                           showFilePath       parseFilePath
276
277
278
279
280
281
282
283
284
                           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
285
286
287
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))
288
289
290
291
   (\lineNo val st -> do
       x <- runP lineNo name readF val
       return (set x st))

ka2_mail's avatar
ka2_mail committed
292
293
listField :: String -> (a -> Doc) -> (ReadP [a] a) -> (b -> [a]) -> ([a] -> b -> b) -> StanzaField b
listField name showF readF get set = StanzaField name
294
   (\st -> case get st of
ka2_mail's avatar
ka2_mail committed
295
        [] -> empty
296
        (value:values) ->
ka2_mail's avatar
ka2_mail committed
297
298
           text name <> vcat (               colon <+> showF value:
                              map (\value -> comma <+> showF value) values))
299
300
301
302
   (\lineNo val st -> do
       xs <- runP lineNo name (parseCommaList readF) val
       return (set xs st))

ka2_mail's avatar
ka2_mail committed
303
304
licenseField :: String -> Bool -> (b -> License) -> (License -> b -> b) -> StanzaField b
licenseField name flag get set = StanzaField name
305
   (\st -> case get st of
ka2_mail's avatar
ka2_mail committed
306
307
308
309
             OtherLicense path | flag      -> text name <> colon <+> showFilePath path
                               | otherwise -> empty
             license           | not flag  -> text name <> colon <+> text (show license)
                               | otherwise -> empty)
310
311
312
313
314
315
316
317
318
   (\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
319
320
optsField :: String -> CompilerFlavor -> (b -> [(CompilerFlavor,[String])]) -> ([(CompilerFlavor,[String])] -> b -> b) -> StanzaField b
optsField name flavor get set = StanzaField name
321
   (\st -> case lookup flavor (get st) of
ka2_mail's avatar
ka2_mail committed
322
323
        Just args -> text name <> colon <+> hsep (map text args)
        Nothing   -> empty)
324
325
326
327
328
329
330
331
332
333
334
335
336
337
   (\lineNo val st -> 
       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
338
339
readPackageDescription fpath = do 
  str <- readFile fpath
340
341
342
343
344
  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
345
parseDescription :: String -> Either PError PackageDescription
346
parseDescription inp = do let (st:sts) = splitStanzas inp
347
                          pkg <- foldM (parseBasicStanza basicStanzaFields) emptyPackageDescription st
348
349
350
                          exes <- mapM parseExecutableStanza sts
                          return pkg{executables=exes}
  where -- The basic stanza, with library building info
ka2_mail's avatar
ka2_mail committed
351
        parseBasicStanza ((StanzaField name get set):fields) pkg (lineNo, f, val)
352
353
354
355
356
357
358
359
          | 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'}

        parseExecutableStanza st@((lineNo, f@"executable",eName):st1) =
360
          case lookupField "main-is" st of
361
362
363
364
	    Just (lineNo,val) -> foldM (parseExecutableField executableStanzaFields) emptyExecutable st
	    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
365
        parseExecutableStanza _ = error "This shouldn't happen!"
366

ka2_mail's avatar
ka2_mail committed
367
        parseExecutableField ((StanzaField name get set):fields) exe (lineNo, f, val)
368
369
370
371
372
373
	  | 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}

ka2_mail's avatar
ka2_mail committed
374
        parseBInfoField ((StanzaField name get set):fields) binfo (lineNo, f, val)
375
376
377
378
	  | name == f = set lineNo val binfo
	  | otherwise = parseBInfoField fields binfo (lineNo, f, val)
	parseBInfoField [] binfo (lineNo, f, val) =
	  myError lineNo $ "Unknown field '" ++ f ++ "'"
md9ms's avatar
md9ms committed
379
        -- ...
380
381
382
383
384
385
        lookupField :: String -> Stanza -> Maybe (LineNo,String)
        lookupField x [] = Nothing
        lookupField x ((n,f,v):st)
          | x == f      = Just (n,v)
          | otherwise   = lookupField x st

386

387
388
389
390
391
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
392
             [a] -> Right a
393
394
395
396
             []  -> Left (NoParse field lineNo)
             _   -> Left (AmbigousParse field lineNo)
    _   -> Left (AmbigousParse field lineNo)
  where results = readP_to_S p s
397

398
399
type Stanza = [(LineNo,String,String)]

400
401
402
-- |Split a string into blank line-separated stanzas of
-- "Field: value" groups
splitStanzas :: String -> [Stanza]
403
404
405
406
407
408
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)]]
409
        groupStanzas [] = []
410
411
412
        groupStanzas xs = let (ys,zs) = break allSpaces xs
                           in ys : groupStanzas (dropWhile allSpaces zs)
        merge ((n,x):(_,' ':s):ys) = case dropWhile isSpace s of
413
414
                                       ('.':s') -> merge ((n,x++"\n"++s'):ys)
                                       s'       -> merge ((n,x++"\n"++s'):ys)
415
416
417
418
419
        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)
                     (fld, _)       -> error $ "Line "++show n++": Invalid syntax (no colon after field name)"
ijones's avatar
ijones committed
420

421
-- |parse a module name
422
parseModuleName :: ReadP r String
md9ms's avatar
md9ms committed
423
424
425
parseModuleName = do c <- satisfy isUpper
                     cs <- munch (\x -> isAlphaNum x || x `elem` "_'.")
                     return (c:cs)
426
427
428
429

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

ka2_mail's avatar
ka2_mail committed
430
431
432
433
434
435
showFilePath :: FilePath -> Doc
showFilePath fpath
	| all (\x -> isAlphaNum x || x `elem` "-+/_.") fpath = text fpath
	| otherwise = doubleQuotes (text fpath)


436
437
438
parseReadS :: Read a => ReadP r a
parseReadS = readS_to_P reads

439
440
441
442
443
parsePackageName :: ReadP r String
parsePackageName = do n <- satisfy isAlpha
                      name <- munch1 (\x -> isAlphaNum x || x `elem` "-")
                      return (n:name)

444
parseDependency :: ReadP r Dependency
445
parseDependency = do name <- parsePackageName
446
447
448
                     skipSpaces
                     ver <- parseVersionRange <++ return AnyVersion
                     skipSpaces
449
450
                     return $ Dependency name ver

451
parseLicense :: ReadP r License
452
parseLicense = parseReadS
ijones's avatar
ijones committed
453

454
parseExtension :: ReadP r Extension
md9ms's avatar
md9ms committed
455
parseExtension = parseReadS
md9ms's avatar
md9ms committed
456

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

460
461
462
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
463
    where separator = skipSpaces >> Compat.ReadP.char ',' >> skipSpaces
ijones's avatar
ijones committed
464
465


466
467
468
469
470

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

writePackageDescription :: FilePath -> PackageDescription -> IO ()
ka2_mail's avatar
ka2_mail committed
471
472
473
474
475
476
477
478
479
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))
480
  where
ka2_mail's avatar
ka2_mail committed
481
482
483
484
485
486
487
488
    ppExecutable exe =
      space $$
      ppFields exe executableStanzaFields $$
      ppFields (buildInfo exe) binfoFields

    ppFields pkg [] = empty
    ppFields pkg ((StanzaField name get set):flds) =
           get pkg $$ ppFields pkg flds
489
        
ka2_mail's avatar
ka2_mail committed
490
491
showDependency :: Dependency -> Doc
showDependency (Dependency name ver) = text name <+> text (showVersionRange ver)
492

ijones's avatar
ijones committed
493
494
495
496
-- ------------------------------------------------------------
-- * Testing
-- ------------------------------------------------------------
#ifdef DEBUG
497
498
499
500
501
502
503
504
505
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",
506
507
        "Modules: Distribution.Package, Distribution.Version,",
        "         Distribution.Simple.GHCPackageConfig",
508
509
510
        "C-Sources: not/even/rain.c, such/small/hands",
        "HS-Source-Dir: src",
        "Exposed-Modules: Distribution.Void, Foo.Bar",
md9ms's avatar
md9ms committed
511
        "Extensions: OverlappingInstances, TypeSynonymInstances",
512
513
        "Extra-Libs: libfoo, bar, bang",
        "Include-Dirs: your/slightest, look/will",
md9ms's avatar
md9ms committed
514
        "Includes: /easily/unclose, /me, \"funky, path\\\\name\"",
515
        "Options-ghc: -fTH -fglasgow-exts",
516
517
518
519
        "Options-hugs: +TH",
        "",
        "-- Next is an executable",
        "Executable: somescript",
520
        "Main-is: SomeFile.hs",
521
522
523
        "Modules: Foo1, Util, Main",
        "HS-Source-Dir: scripts",
        "Extensions: OverlappingInstances"
524
        ]
ijones's avatar
ijones committed
525
526
527

testPkgDescAnswer = 
 PackageDescription {package = PackageIdentifier {pkgName = "Cabal",
ijones's avatar
ijones committed
528
                                                 pkgVersion = Version {versionBranch = [0,1,1,1,1],
md9ms's avatar
md9ms committed
529
                                                 versionTags = ["rain"]}},
ijones's avatar
ijones committed
530
                    license = LGPL,
ijones's avatar
ijones committed
531
                    copyright = "Free Text String",
ijones's avatar
ijones committed
532
                    maintainer = "",
ijones's avatar
ijones committed
533
                    stability = "Free Text String",
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549

                    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
550
                        includes = ["/easily/unclose", "/me", "funky, path\\name"],
551
552
                        -- Note reversed order:
                        options = [(Hugs,["+TH"]), (GHC,["-fTH","-fglasgow-exts"])]
553
                    },
554
555
                    executables = [Executable "somescript" "SomeFile.hs" (
                      emptyBuildInfo{
556
557
558
559
                        modules = ["Foo1","Util","Main"],
                        hsSourceDir = "scripts",
                        extensions = [OverlappingInstances]
                      })]
ijones's avatar
ijones committed
560
561
}

ijones's avatar
ijones committed
562
hunitTests :: [Test]
563
hunitTests = [
md9ms's avatar
md9ms committed
564
565
              TestLabel "license parsers" $ TestCase $
                 sequence_ [assertRight ("license " ++ show lVal) lVal
566
                                        (runP 1 "license" parseLicense (show lVal))
md9ms's avatar
md9ms committed
567
                           | lVal <- [GPL,LGPL,BSD3,BSD4]],
ijones's avatar
ijones committed
568
569
570
571

              TestLabel "Required fields" $ TestCase $
                 do assertRight "some fields"
                       emptyPackageDescription{package=(PackageIdentifier "foo"
md9ms's avatar
md9ms committed
572
                                                        (Version [0,0] ["asdf"]))}
ijones's avatar
ijones committed
573
574
575
576
                       (parseDescription "Name: foo\nVersion: 0.0-asdf")

                    assertRight "more fields foo"
                       emptyPackageDescription{package=(PackageIdentifier "foo"
md9ms's avatar
md9ms committed
577
                                                        (Version [0,0]["asdf"])),
ijones's avatar
ijones committed
578
579
580
581
582
                                               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
583
                                                        (Version [0,0]["asdf"])),
ijones's avatar
ijones committed
584
585
586
                                        license=GPL, copyright="2004 isaac jones"}
                       (parseDescription "Name: foo\nVersion:0.0-asdf\nCopyright: 2004 isaac jones\nLicense: GPL"),
                                          
587
             TestCase $ assertRight "no library" Nothing
588
                        (library `liftM` parseDescription "Name: foo\nVersion: 1\nLicense: GPL\nMaintainer: someone\n\nExecutable: script\nMain-is: SomeFile.hs\n"),
ijones's avatar
ijones committed
589
590
591
592

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

ijones's avatar
ijones committed
594
595
             ]

ijones's avatar
ijones committed
596

ijones's avatar
ijones committed
597
598
599
600
601
602
603
604
605
606
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
607
test = runTestTT (TestList hunitTests)
ijones's avatar
ijones committed
608
#endif