Package.hs 28.5 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
	emptyPackageDescription,
        readPackageDescription,
49
	parseDescription,
50
        writePackageDescription,
51
52
53
54
	showPackageDescription,
	basicStanzaFields,
        setupMessage,
        withLib,
55
        hasLibs,
md9ms's avatar
md9ms committed
56
        BuildInfo(..),
ka2_mail's avatar
ka2_mail committed
57
        emptyBuildInfo,
58
        Executable(..),
59
        emptyExecutable,
60
61
	StanzaField(..),
        allModules,
ijones's avatar
ijones committed
62
#ifdef DEBUG
63
        hunitTests,
ijones's avatar
ijones committed
64
        test
ijones's avatar
ijones committed
65
#endif
66
  ) where
67

ijones's avatar
ijones committed
68
import Control.Monad(foldM, liftM, when)
69
import Data.Char
ijones's avatar
ijones committed
70
import Data.List(concatMap)
ijones's avatar
ijones committed
71
import Data.Maybe(fromMaybe, fromJust)
ka2_mail's avatar
ka2_mail committed
72
import Text.PrettyPrint.HughesPJ
ijones's avatar
ijones committed
73

74
import Distribution.Version(Version(..), VersionRange(..),
75
76
                            showVersion, parseVersion, 
                            showVersionRange, parseVersionRange)
md9ms's avatar
md9ms committed
77
import Distribution.Misc(License(..), Dependency(..), Extension(..))
md9ms's avatar
md9ms committed
78
import Distribution.Setup(CompilerFlavor(..))
ijones's avatar
ijones committed
79
import Distribution.Simple.Utils(currentDir)
80

81
import Compat.H98
ijones's avatar
ijones committed
82
import Compat.ReadP hiding (get)
ijones's avatar
ijones committed
83

ijones's avatar
ijones committed
84
#ifdef DEBUG
ijones's avatar
ijones committed
85
import HUnit (Test(..), (~:), (~=?), assertEqual, assertBool, Assertion, runTestTT)
ijones's avatar
ijones committed
86
87
#endif

88
89
data PackageIdentifier
    = PackageIdentifier {pkgName::String, pkgVersion::Version}
simonmar's avatar
simonmar committed
90
      deriving (Read, Show, Eq)
91

simonmar's avatar
simonmar committed
92
showPackageId :: PackageIdentifier -> String
ijones's avatar
ijones committed
93
showPackageId (PackageIdentifier n (Version [] _)) = n -- if no version, don't show version.
simonmar's avatar
simonmar committed
94
95
96
showPackageId pkgid = 
  pkgName pkgid ++ '-': showVersion (pkgVersion pkgid)

97

98
99
100
101
102
103
104
105
106
107
-- | 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,
108
        license        :: License,
109
110
        copyright      :: String,
        maintainer     :: String,
111
	author         :: String,
112
        stability      :: String,
113
114
115
116
117
	testedWith     :: [(CompilerFlavor,VersionRange)],
	homepage       :: String,
	pkgUrl         :: String,
	description    :: String,
	category       :: String,
118
        library        :: Maybe BuildInfo,
119
120
121
122
        executables    :: [Executable]
    }
    deriving (Show, Read, Eq)

123
124
125
126
127
128
emptyPackageDescription :: PackageDescription
emptyPackageDescription
    =  PackageDescription {package      = PackageIdentifier "" (Version [] []),
                      license      = AllRightsReserved,
                      copyright    = "",
                      maintainer   = "",
129
		      author       = "",
130
                      stability    = "",
131
132
133
134
135
		      testedWith   = [],
		      homepage     = "",
		      pkgUrl       = "",
		      description  = "",
		      category     = "",
136
137
138
                      library      = Nothing,
                      executables  = []
                     }
ijones's avatar
ijones committed
139

140
-- |Get all the module names from this package
141
142
143
144
allModules :: PackageDescription -> [String]
allModules PackageDescription{executables=execs, library=lib}
    = (concatMap (\e -> modules $ buildInfo e) execs)
         ++ (maybe [] modules lib)
145

146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
-- |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

            
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
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       = [],
184
		      hsSourceDir    = currentDir,
185
186
187
188
189
190
                      extensions     = [],
                      extraLibs      = [],
                      includeDirs    = [],
                      includes       = [],
                      options        = []
                     }
191
                     
192
193
194
195
-- |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
196

ijones's avatar
ijones committed
197

198
199
200
201
202
203
204
205
206
207
208
209
210
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
211

ijones's avatar
ijones committed
212
213
214
215
216
217
218
219
220
221
222
223
224
225
-- ------------------------------------------------------------
-- * Utils
-- ------------------------------------------------------------

-- |If the package description has a library section, call the given
--  function with the library build info as argument.
withLib :: PackageDescription -> (BuildInfo -> IO ()) -> IO ()
withLib pkg_descr f = when (hasLibs pkg_descr) $ f (fromJust (library pkg_descr))

setupMessage :: String -> PackageDescription -> IO ()
setupMessage msg pkg_descr = 
   putStrLn (msg ++ ' ':showPackageId (package pkg_descr) ++ "...")


ijones's avatar
ijones committed
226
-- ------------------------------------------------------------
227
-- * Parsing & Pretty printing
ijones's avatar
ijones committed
228
229
-- ------------------------------------------------------------

230
231
232
233
234
type LineNo = Int

data PError = AmbigousParse String LineNo
            | NoParse String LineNo
            | FromString String (Maybe LineNo)
md9ms's avatar
md9ms committed
235
236
237
        deriving Show

instance Error PError where
238
        strMsg s = FromString s Nothing
md9ms's avatar
md9ms committed
239

md9ms's avatar
md9ms committed
240
showError :: PError -> String
241
242
243
244
245
246
247
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
248

ka2_mail's avatar
ka2_mail committed
249
250
data StanzaField a 
  = StanzaField 
251
      { fieldName     :: String
252
      , fieldShow     :: a -> Doc
ka2_mail's avatar
ka2_mail committed
253
      , fieldGet      :: a -> Doc
254
255
256
      , fieldSet      :: LineNo -> String -> a -> Either PError a
      }

ka2_mail's avatar
ka2_mail committed
257
basicStanzaFields :: [StanzaField PackageDescription]
258
259
basicStanzaFields =
 [ simpleField "name"
ka2_mail's avatar
ka2_mail committed
260
                           text                   parsePackageName
261
262
                           (pkgName . package)    (\name pkg -> pkg{package=(package pkg){pkgName=name}})
 , simpleField "version"
ka2_mail's avatar
ka2_mail committed
263
                           (text . showVersion)   parseVersion 
264
265
266
267
268
269
                           (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
270
                           text                   (munch (const True))
271
272
                           copyright              (\val pkg -> pkg{copyright=val})
 , simpleField "maintainer"
ka2_mail's avatar
ka2_mail committed
273
                           text                   (munch (const True))
274
275
                           maintainer             (\val pkg -> pkg{maintainer=val})
 , simpleField "stability"
ka2_mail's avatar
ka2_mail committed
276
                           text                   (munch (const True))
277
                           stability              (\val pkg -> pkg{stability=val})
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
 , simpleField "homepage"
                           text                   (munch (const True))
                           homepage               (\val pkg -> pkg{homepage=val})
 , simpleField "package-url"
                           text                   (munch (const True))
                           pkgUrl                 (\val pkg -> pkg{pkgUrl=val})
 , simpleField "description"
                           text                   (munch (const True))
                           description            (\val pkg -> pkg{description=val})
 , simpleField "category"
                           text                   (munch (const True))
                           category               (\val pkg -> pkg{category=val})
 , simpleField "author"
                           text                   (munch (const True))
                           author                 (\val pkg -> pkg{author=val})
 , listField "tested-with"
                           showTestedWith         parseTestedWith
                           testedWith             (\val pkg -> pkg{testedWith=val})

297
298
 ]

ka2_mail's avatar
ka2_mail committed
299
executableStanzaFields :: [StanzaField Executable]
300
301
executableStanzaFields =
 [ simpleField "executable"
ka2_mail's avatar
ka2_mail committed
302
                           text               (munch (const True))
303
304
                           exeName            (\xs    exe -> exe{exeName=xs})
 , simpleField "main-is"
ka2_mail's avatar
ka2_mail committed
305
                           showFilePath       parseFilePath
306
307
308
                           modulePath         (\xs    exe -> exe{modulePath=xs})
 ]

ka2_mail's avatar
ka2_mail committed
309
binfoFields :: [StanzaField BuildInfo]
310
311
312
313
314
binfoFields =
 [ listField   "build-depends"   
                           showDependency     parseDependency
                           buildDepends       (\xs    binfo -> binfo{buildDepends=xs})
 , listField   "modules"         
ka2_mail's avatar
ka2_mail committed
315
                           text               parseModuleName
316
317
                           modules            (\xs    binfo -> binfo{modules=xs})
 , listField   "exposed-modules"
ka2_mail's avatar
ka2_mail committed
318
                           text               parseModuleName
319
320
                           exposedModules     (\xs    binfo -> binfo{exposedModules=xs})
 , listField   "c-sources"
ka2_mail's avatar
ka2_mail committed
321
                           showFilePath       parseFilePath
322
323
                           cSources           (\paths binfo -> binfo{cSources=paths})
 , listField   "extensions"
ka2_mail's avatar
ka2_mail committed
324
                           (text . show)      parseExtension
325
326
                           extensions         (\exts  binfo -> binfo{extensions=exts})
 , listField   "extra-libs"
ka2_mail's avatar
ka2_mail committed
327
                           text               parseLibName
328
329
                           extraLibs          (\xs    binfo -> binfo{extraLibs=xs})
 , listField   "includes"
ka2_mail's avatar
ka2_mail committed
330
                           showFilePath       parseFilePath
331
                           includes           (\paths binfo -> binfo{includes=paths})
ka2_mail's avatar
ka2_mail committed
332
333
334
 , listField   "include-dirs"
                           showFilePath       parseFilePath
                           includes           (\paths binfo -> binfo{includeDirs=paths})
335
 , simpleField "hs-source-dir"
ka2_mail's avatar
ka2_mail committed
336
                           showFilePath       parseFilePath
337
338
339
340
341
342
343
344
345
                           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
346
347
348
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))
349
   (showF . get)
350
351
352
353
   (\lineNo val st -> do
       x <- runP lineNo name readF val
       return (set x st))

ka2_mail's avatar
ka2_mail committed
354
355
listField :: String -> (a -> Doc) -> (ReadP [a] a) -> (b -> [a]) -> ([a] -> b -> b) -> StanzaField b
listField name showF readF get set = StanzaField name
356
   (\st -> case get st of
ka2_mail's avatar
ka2_mail committed
357
        [] -> empty
358
359
360
361
362
363
        lst ->
           text name <> vcat (map (\value -> comma <+> showF value) lst))
   (\st -> case get st of
        [] -> empty
        lst ->
           vcat (map (\value -> comma <+> showF value) lst))
364
365
366
367
   (\lineNo val st -> do
       xs <- runP lineNo name (parseCommaList readF) val
       return (set xs st))

ka2_mail's avatar
ka2_mail committed
368
369
licenseField :: String -> Bool -> (b -> License) -> (License -> b -> b) -> StanzaField b
licenseField name flag get set = StanzaField name
370
   (\st -> case get st of
ka2_mail's avatar
ka2_mail committed
371
372
             OtherLicense path | flag      -> text name <> colon <+> showFilePath path
                               | otherwise -> empty
ijones's avatar
ijones committed
373
             license'          | not flag  -> text name <> colon <+> text (show license')
ka2_mail's avatar
ka2_mail committed
374
                               | otherwise -> empty)
375
376
377
378
379
   (\st -> case get st of
             OtherLicense path | flag      -> showFilePath path
                               | otherwise -> empty
             license'          | not flag  -> text (show license')
                               | otherwise -> empty)
380
381
382
383
384
385
386
387
388
   (\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
389
390
optsField :: String -> CompilerFlavor -> (b -> [(CompilerFlavor,[String])]) -> ([(CompilerFlavor,[String])] -> b -> b) -> StanzaField b
optsField name flavor get set = StanzaField name
391
   (\st -> case lookup flavor (get st) of
ka2_mail's avatar
ka2_mail committed
392
393
        Just args -> text name <> colon <+> hsep (map text args)
        Nothing   -> empty)
394
395
396
   (\st -> case lookup flavor (get st) of
        Just args -> sep (map text args)
        Nothing   -> empty)
ijones's avatar
ijones committed
397
   (\_ val st -> 
398
399
400
401
402
403
404
405
406
407
408
409
410
       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
411
412
readPackageDescription fpath = do 
  str <- readFile fpath
413
414
415
416
417
  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
418
parseDescription :: String -> Either PError PackageDescription
419
parseDescription inp = do let (st:sts) = splitStanzas inp
420
                          pkg <- foldM (parseBasicStanza basicStanzaFields) emptyPackageDescription st
421
422
423
                          exes <- mapM parseExecutableStanza sts
                          return pkg{executables=exes}
  where -- The basic stanza, with library building info
424
        parseBasicStanza ((StanzaField name _ _ set):fields) pkg (lineNo, f, val)
425
426
427
428
429
430
431
          | 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
432
        parseExecutableStanza st@((_, "executable",eName):_) =
433
          case lookupField "main-is" st of
ijones's avatar
ijones committed
434
	    Just (_,_) -> foldM (parseExecutableField executableStanzaFields) emptyExecutable st
435
436
437
	    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
438
        parseExecutableStanza _ = error "This shouldn't happen!"
439

440
        parseExecutableField ((StanzaField name _ _ set):fields) exe (lineNo, f, val)
441
442
443
444
445
446
	  | 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}

447
        parseBInfoField ((StanzaField name _ _ set):fields) binfo (lineNo, f, val)
448
449
	  | name == f = set lineNo val binfo
	  | otherwise = parseBInfoField fields binfo (lineNo, f, val)
450
	parseBInfoField [] binfo (lineNo, f, _) =
451
	  myError lineNo $ "Unknown field '" ++ f ++ "'"
md9ms's avatar
md9ms committed
452
        -- ...
453
        lookupField :: String -> Stanza -> Maybe (LineNo,String)
ijones's avatar
ijones committed
454
        lookupField _ [] = Nothing
455
456
457
458
        lookupField x ((n,f,v):st)
          | x == f      = Just (n,v)
          | otherwise   = lookupField x st

459

460
461
462
463
464
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
465
             [a] -> Right a
466
467
468
469
             []  -> Left (NoParse field lineNo)
             _   -> Left (AmbigousParse field lineNo)
    _   -> Left (AmbigousParse field lineNo)
  where results = readP_to_S p s
470

471
472
type Stanza = [(LineNo,String,String)]

473
474
475
-- |Split a string into blank line-separated stanzas of
-- "Field: value" groups
splitStanzas :: String -> [Stanza]
476
477
478
479
480
481
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)]]
482
        groupStanzas [] = []
483
484
485
        groupStanzas xs = let (ys,zs) = break allSpaces xs
                           in ys : groupStanzas (dropWhile allSpaces zs)
        merge ((n,x):(_,' ':s):ys) = case dropWhile isSpace s of
486
487
                                       ('.':s') -> merge ((n,x++"\n"++s'):ys)
                                       s'       -> merge ((n,x++"\n"++s'):ys)
488
489
490
491
        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
492
                     (_, _)       -> error $ "Line "++show n++": Invalid syntax (no colon after field name)"
ijones's avatar
ijones committed
493

494
-- |parse a module name
495
parseModuleName :: ReadP r String
md9ms's avatar
md9ms committed
496
497
498
parseModuleName = do c <- satisfy isUpper
                     cs <- munch (\x -> isAlphaNum x || x `elem` "_'.")
                     return (c:cs)
499

500
501
502
503
504
505
506
parseTestedWith :: ReadP [(CompilerFlavor,VersionRange)] (CompilerFlavor,VersionRange)
parseTestedWith = do compiler <- parseReadS
		     skipSpaces
		     version <- parseVersionRange <++ return AnyVersion
		     skipSpaces
		     return (compiler,version)

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

ka2_mail's avatar
ka2_mail committed
510
511
512
513
514
515
showFilePath :: FilePath -> Doc
showFilePath fpath
	| all (\x -> isAlphaNum x || x `elem` "-+/_.") fpath = text fpath
	| otherwise = doubleQuotes (text fpath)


516
517
518
parseReadS :: Read a => ReadP r a
parseReadS = readS_to_P reads

519
520
521
522
523
parsePackageName :: ReadP r String
parsePackageName = do n <- satisfy isAlpha
                      name <- munch1 (\x -> isAlphaNum x || x `elem` "-")
                      return (n:name)

524
parseDependency :: ReadP r Dependency
525
parseDependency = do name <- parsePackageName
526
527
528
                     skipSpaces
                     ver <- parseVersionRange <++ return AnyVersion
                     skipSpaces
529
530
                     return $ Dependency name ver

531
parseLicense :: ReadP r License
532
parseLicense = parseReadS
ijones's avatar
ijones committed
533

534
parseExtension :: ReadP r Extension
md9ms's avatar
md9ms committed
535
parseExtension = parseReadS
md9ms's avatar
md9ms committed
536

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

540
541
542
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
543
    where separator = skipSpaces >> Compat.ReadP.char ',' >> skipSpaces
ijones's avatar
ijones committed
544
545


546
547
548
549

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

550
551
552
showTestedWith :: (CompilerFlavor,VersionRange) -> Doc
showTestedWith (compiler,version) = text (show compiler ++ " " ++ showVersionRange version)

553
writePackageDescription :: FilePath -> PackageDescription -> IO ()
ka2_mail's avatar
ka2_mail committed
554
555
556
557
558
559
560
561
562
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))
563
  where
ka2_mail's avatar
ka2_mail committed
564
565
566
567
568
    ppExecutable exe =
      space $$
      ppFields exe executableStanzaFields $$
      ppFields (buildInfo exe) binfoFields

ijones's avatar
ijones committed
569
    ppFields _ [] = empty
570
    ppFields pkg' ((StanzaField _ get _ _):flds) =
ijones's avatar
ijones committed
571
           get pkg' $$ ppFields pkg' flds
572
        
ka2_mail's avatar
ka2_mail committed
573
574
showDependency :: Dependency -> Doc
showDependency (Dependency name ver) = text name <+> text (showVersionRange ver)
575

ijones's avatar
ijones committed
576
577
578
579
-- ------------------------------------------------------------
-- * Testing
-- ------------------------------------------------------------
#ifdef DEBUG
580
581
582
583
584
585
586
testPkgDesc = unlines [
        "-- Required",
        "Name: Cabal",
        "Version: 0.1.1.1.1-rain",
        "License: LGPL",
        "Copyright: Free Text String",
        "-- Optional - may be in source?",
587
588
589
590
591
592
        "Author: Happy Haskell Hacker",
        "Homepage: http://www.haskell.org/foo",
        "Package-url: http://www.haskell.org/foo",
        "Description: a nice package!",
        "Category: tools",
        "Tested-with: GHC",
593
594
        "Stability: Free Text String",
        "Build-Depends: haskell-src, HUnit>=1.0.0-rain",
595
596
        "Modules: Distribution.Package, Distribution.Version,",
        "         Distribution.Simple.GHCPackageConfig",
597
598
599
        "C-Sources: not/even/rain.c, such/small/hands",
        "HS-Source-Dir: src",
        "Exposed-Modules: Distribution.Void, Foo.Bar",
md9ms's avatar
md9ms committed
600
        "Extensions: OverlappingInstances, TypeSynonymInstances",
601
602
        "Extra-Libs: libfoo, bar, bang",
        "Include-Dirs: your/slightest, look/will",
md9ms's avatar
md9ms committed
603
        "Includes: /easily/unclose, /me, \"funky, path\\\\name\"",
604
        "Options-ghc: -fTH -fglasgow-exts",
605
606
607
608
        "Options-hugs: +TH",
        "",
        "-- Next is an executable",
        "Executable: somescript",
609
        "Main-is: SomeFile.hs",
610
611
612
        "Modules: Foo1, Util, Main",
        "HS-Source-Dir: scripts",
        "Extensions: OverlappingInstances"
613
        ]
ijones's avatar
ijones committed
614
615
616

testPkgDescAnswer = 
 PackageDescription {package = PackageIdentifier {pkgName = "Cabal",
ijones's avatar
ijones committed
617
                                                 pkgVersion = Version {versionBranch = [0,1,1,1,1],
md9ms's avatar
md9ms committed
618
                                                 versionTags = ["rain"]}},
ijones's avatar
ijones committed
619
                    license = LGPL,
ijones's avatar
ijones committed
620
                    copyright = "Free Text String",
621
622
623
624
625
626
                    author  = "Happy Haskell Hacker",
                    homepage = "http://www.haskell.org/foo",
                    pkgUrl   = "http://www.haskell.org/foo",
                    description = "a nice package!",
                    category = "tools",
                    testedWith=[(GHC, AnyVersion)],
ijones's avatar
ijones committed
627
                    maintainer = "",
ijones's avatar
ijones committed
628
                    stability = "Free Text String",
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644

                    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
645
                        includes = ["/easily/unclose", "/me", "funky, path\\name"],
646
647
                        -- Note reversed order:
                        options = [(Hugs,["+TH"]), (GHC,["-fTH","-fglasgow-exts"])]
648
                    },
649
650
                    executables = [Executable "somescript" "SomeFile.hs" (
                      emptyBuildInfo{
651
652
653
654
                        modules = ["Foo1","Util","Main"],
                        hsSourceDir = "scripts",
                        extensions = [OverlappingInstances]
                      })]
ijones's avatar
ijones committed
655
656
}

ijones's avatar
ijones committed
657
hunitTests :: [Test]
658
hunitTests = [
md9ms's avatar
md9ms committed
659
660
              TestLabel "license parsers" $ TestCase $
                 sequence_ [assertRight ("license " ++ show lVal) lVal
661
                                        (runP 1 "license" parseLicense (show lVal))
md9ms's avatar
md9ms committed
662
                           | lVal <- [GPL,LGPL,BSD3,BSD4]],
ijones's avatar
ijones committed
663
664
665
666

              TestLabel "Required fields" $ TestCase $
                 do assertRight "some fields"
                       emptyPackageDescription{package=(PackageIdentifier "foo"
md9ms's avatar
md9ms committed
667
                                                        (Version [0,0] ["asdf"]))}
ijones's avatar
ijones committed
668
669
670
671
                       (parseDescription "Name: foo\nVersion: 0.0-asdf")

                    assertRight "more fields foo"
                       emptyPackageDescription{package=(PackageIdentifier "foo"
md9ms's avatar
md9ms committed
672
                                                        (Version [0,0]["asdf"])),
ijones's avatar
ijones committed
673
674
675
676
677
                                               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
678
                                                        (Version [0,0]["asdf"])),
ijones's avatar
ijones committed
679
680
681
                                        license=GPL, copyright="2004 isaac jones"}
                       (parseDescription "Name: foo\nVersion:0.0-asdf\nCopyright: 2004 isaac jones\nLicense: GPL"),
                                          
682
             TestCase $ assertRight "no library" Nothing
683
                        (library `liftM` parseDescription "Name: foo\nVersion: 1\nLicense: GPL\nMaintainer: someone\n\nExecutable: script\nMain-is: SomeFile.hs\n"),
ijones's avatar
ijones committed
684
685
686
687

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

ijones's avatar
ijones committed
689
690
             ]

ijones's avatar
ijones committed
691

ijones's avatar
ijones committed
692
693
694
695
696
697
698
699
700
701
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
702
test = runTestTT (TestList hunitTests)
ijones's avatar
ijones committed
703
#endif